HPAVC/HPAVC CD-ROM.iso/pc/VGADOC4B.ZIP/IDVGA.PAS

Pascal/Delphi Source File | 1995-09-29 | 132.2 KB | 4,469 lines

unit idvga;
interface
procedure DumpRegisters;

procedure AnalyseMode;

procedure CalcRegisters;

function dumpVGAregs:word;

procedure dumpVGAregfile;

procedure loadmodes;

function FormatRgs(var b:byte):word;   {Format registers for dump}

  {Weitek W5x86 Enable function
   Sets the Extention & Bank enable flags in SEQ index $11}
function WeitekEnable(flag:word):word;

  {Check for PCI devices}
procedure findPCI;

 {Checks for a PCI card with ID=sign, returns index in PCIrec, 0 if not found
  start is the PCI device to start at (0 first time, last ID next time)}
function CheckPCI(start,vendor,device:word):integer;

procedure findvideo;

procedure testdac;

function dacis8bit:boolean;

function DACflags:word;

procedure wPCIbyte(index,val:word);
procedure wPCIword(index,val:word);
procedure wPCIlong(index:word;val:longint);
function rPCIbyte(index:word):word;
function rPCIword(index:word):word;
function rPCIlong(index:word):longint;



const
  PCIdevs:word=0;       {Number of PCI video devices}
var
  PCItype:word;
  PCIrec:array[1..10] of record
           PCIbase:word;
           case integer of
             0:(l:array[0..63] of longint);
             1:(vendor,device,command,status:word;
                rev,prog:byte;class:word;
                cache,latency,header,bist:byte;
                base0,base1,base2,base3,base4,base5
                     ,xx0,xx1,rom,xx2,xx3:longint;
                iline,ipin,mingnt,maxlat:byte);
         end;


{$i idvga2.pas}   {Holds all the Chipset, mode etc definitions.}


function DACflags:word;
var flag:word;
begin
  flag:=0;
  case cv.dactype of
  _dac0,_dac8,_dacCEG:;

  _dacInt:;
  _dac15,_dac16,_dacADAC1,_dacSC486,_dacUMC188:
       flag:=DFL_CmdReg;

  _dacALG1101:;
  _dacALG1201,_dacALG1301:
       flag:=DFL_CmdReg;

  _dacATI68860,_dacATI68880:
       flag:=DFL_8bit;

  _dacATT490,_dacATT491:
       flag:=DFL_CmdReg+DFL_8bit;
  _dacATT492,_dacATT493:
       flag:=DFL_CmdReg;
  _dacATT498,_dacATT1498,_dacATT2498:
       flag:=DFL_CmdReg+DFL_8bit;

  _dacBt477:
       flag:=DFL_8bit;
  _dacBt481,_dacBt482:
       flag:=DFL_CmdReg+DFL_8bit+DFL_cursor;
  _dacBt484,_dacBt485,_dacATT504,_dacATT505:
       flag:=DFL_8bit+DFL_cursor;

  _dacCH8391,
  _dacCH8398:
       flag:=DFL_CmdReg+DFL_8bit+DFL_Clock;

  _dacCL5200:
       flag:=DFL_CmdReg;

  _dacIBM514,_dacIBM524,_dacIBM525,_dacIBM528:
       flag:=DFL_cursor+DFL_8bit+DFL_Clock;

  _dacICS5301:
       flag:=DFL_CmdReg;

  _dacICW498,_dacICW516:
       flag:=DFL_CmdReg+DFL_8bit;

  _dacMU1880,_dacMU4870:
       flag:=DFL_CmdReg;
  _dacMU4910:
       flag:=DFL_CmdReg+DFL_8bit;
  _dacMU9910:
       flag:=DFL_CmdReg+DFL_8bit+DFL_Clock;

  _dacS3_716,_dacS3_708:
       flag:=DFL_CmdReg+DFL_8bit+DFL_Clock;
  _dacSC15021,_dacSC15025:
       flag:=DFL_CmdReg+DFL_8bit;
  _dacSTG1700,_dacSTG1702:
       flag:=DFL_CmdReg+DFL_8bit;
  _dacSTG1703:
       flag:=DFL_CmdReg+DFL_8bit+DFL_Clock;
  _dacTLC34075,_dacTLC34076:
       flag:=DFL_8bit;    {8bit DACs from input pin}
  _dacTR8001:
       flag:=DFL_CmdReg+DFL_8bit;
  _dacTVP3010,_dacTVP3020:
       flag:=DFL_8bit+DFL_Cursor;
  _dacTVP3025,_dacTVP3026:
       flag:=DFL_8bit+DFL_Cursor+DFL_Clock;
  end;
  DACflags:=flag;
end;

procedure loadmodes;              {Load extended modes for this chip}
var
  t:text;
  s,pat:string;
  md,x,xres,yres,err,mreq,byt:word;
  vbe0:_vbe0;
  vbe1:_vbe1;
  xbe1:_xbe1;
  xbe2:_xbe2;
  ok:boolean;

function VESAmemmode(model,bits,redinf,grninf,bluinf,resinf:word):integer;
const
  mode6s=8;
  mode:array[1..mode6s] of byte=(
       _p15,_p16,_p24 ,_p24b,_p32 ,_p32b,_p32c,_p32d);
  blui:array[1..mode6s] of word =(
          5,   5,    8,$1008,    8,$1008, $808,$1808);
  grni:array[1..mode6s] of word =(
       $505,$506, $808, $808, $808, $808,$1008,$1008);
  redi:array[1..mode6s] of word =(
       $A05,$B05,$1008,    8,$1008,    8,$1808, $808);
  resi:array[1..mode6s] of word =(
       $F01,   0,    0,    0,$1808,$1808,    8,    8);
var x:word;
begin
  VESAmemmode:=_text;  {catch weird modes}
  if (bits=15) and (resinf=0) then resinf:=$F01;   {Bloody ATI Vesa driver @#$}
  if (bits=15) and (bluinf=5) and (grninf=$405) then grninf:=$505;
                                                   {@#$ Mach64 VESA driver}
  case model of
    0:VESAmemmode:=_text;
    1:case bits of
        1:VESAmemmode:=_cga1;
        2:VESAmemmode:=_cga2;
      end;
    2:VESAmemmode:=_herc;
    3:case bits of
        2:VESAmemmode:=_pl2;
        4:VESAmemmode:=_pl4;
      end;
    4:case bits of
        4:VESAmemmode:=_pk4;
        8:VESAmemmode:=_p8;
       15:VESAmemmode:=_p15;
       16:VESAmemmode:=_p16;
       24:VESAmemmode:=_p24;
      end;
    5:; {YUV coding}
    6:for x:=1 to mode6s do
      if (redinf=redi[x]) and (grninf=grni[x]) and (bluinf=blui[x])
        and (resinf=resi[x]) then VESAmemmode:=mode[x];
    7:;
  end;
end;


procedure addmode(md,xres,yres,bytes:word;memmode:integer);
begin
  inc(nomodes);
  modetbl[nomodes].md     :=md;
  modetbl[nomodes].xres   :=xres;
  modetbl[nomodes].yres   :=yres;
  modetbl[nomodes].bytes  :=bytes;
  modetbl[nomodes].memmode:=memmode;
  modetbl[nomodes].flags  :=MFL_enabled;
  if memmode>=_PL4 then
    modetbl[nomodes].flags:=modetbl[nomodes].flags OR MFL_graphics;
end;

begin
  nomodes:=0;

  if (cv.flags and FLG_StdVGA)>0 then
  begin
    move(stdmodetbl,modetbl,novgamodes*sizeof(modetype));
    nomodes:=novgamodes;
  end;

  case cv.chip of
   __vesa:begin
            vbe0.sign:=$41534556;    (* VESA *)
            viop($4F00,0,0,0,@vbe0);

               {S3 VESA driver can return wrong segment if run with QEMM}
            IF seg(vbe0.model^)=$E000 then
              vbe0.model:=ptr($C000,ofs(vbe0.model^));
            x:=1;
            while vbe0.model^[x]<>$FFFF do
            begin
              vesamodeinfo(vbe0.model^[x],vbe1);
              if (vbe1.attr and 1)<>0 then
              begin
                memmode:=VESAmemmode(vbe1.model,vbe1.bits,vbe1.redinf
                   ,vbe1.grninf,vbe1.bluinf,vbe1.resinf);
                addmode(vbe0.model^[x],vbe1.width,vbe1.height,vbe1.bytes,memmode);
              end;
              inc(x);
            end;
          end;
    __xbe:begin
            viop($4E01,0,0,cv.id,@xbe1);
            x:=1;
            while xbe1.modep^[x]<>$FFFF do
            begin
              viop($4E02,0,xbe1.modep^[x],cv.id,@xbe2);
              if (rp.ax=$4E) and ((xbe2.attrib and 1)>0) then
              begin
                memmode:=VESAmemmode(xbe2.model,xbe2.bits,xbe2.redinf
                   ,xbe2.grninf,xbe2.bluinf,xbe2.resinf);
                if xbe2.bits=4 then memmode:=_pk4;
                addmode(xbe1.modep^[x],xbe2.pixels,xbe2.lins,xbe2.bytes,memmode);
              end;
              inc(x);
            end;

          end;
  else
    for x:=1 to NBRMODES do
      if MODELIST[x].chp=cv.chip then
      begin
        ok:=true;
        md     :=MODELIST[x].md;
        memmode:=MODELIST[x].mode;
        xres   :=MODELIST[x].xres;
        yres   :=MODELIST[x].yres;
        planes:=1;
        if memmode<_herc then bytes:=xres*2
            else bytes:=(xres*usebits[memmode]) shr 3;
        if memmode=_pl4 then
        begin
          bytes:=xres shr 3;
          planes:=4;
        end;

        case cv.dactype of
          _dacCEG,
            _dac8:if memmode>_p8 then ok:=false;
           _dac15:if memmode>_p15 then ok:=false;
           _dac16,_dacMU4870:
                  if memmode>_p16 then ok:=false;
      _dacALG1101:if (memmode=_p15) or (memmode>_p16) then ok:=false;
        end;
        case cv.chip of
         __ALG:if (md=$48) and (cv.Version=ALG_2228) then bytes:=2048;
         __ARK:if (memmode=_P24) and (cv.Version>=ARK_2000PV) then
               begin
                 memmode:=_P32;
                 bytes:=xres*4;
               end;
         __ATI:begin
                 if (md<$100) and (cv.Version<ATI_M64_GX) then
                 begin
                   rp.bx:=$5506;
                   rp.bp:=$FFFF;
                   rp.si:=0;
                   vio($1200+md);
                   if rp.bp=$FFFF then ok:=false;
                 end;
                       {The VGA chip can't handle the ATI dac yet}
                 if (cv.dactype=_dacATI68860) and (memmode>_P8) then ok:=false;
               end;
      __Compaq:if (cv.Version<CPQ_QV) and (md>$2E) then ok:=false;
       __Cir54:if (cv.Version<CL_GD5430) and ((memmode=_p32) or (xres>1280)) then ok:=false;

          __S3:if (cv.version<=S3_924) then
               begin
                 if ((md>$105) and (md<$200)) or (md=$212) or (md=$211) then ok:=false;
               end
               else begin
                 if md>$210 then ok:=false;
                 if (cv.version<S3_928) and (memmode=_p32) then memmode:=_p24;
                 if (cv.version=S3_928) and (memmode=_PK4a) then ok:=false;
               end;
        __Trid:if cv.version=TR_IITAGX then
                 if (md>=$60) then ok:=false;
       __Tseng:case cv.version of
                 ET_3000:if md=$2F then ok:=false;
                 ET_4000:case cv.subvers of
                           TS_SpeedStar:if (hi(md)=2) or (md=$53E) then ok:=false;
                           TS_Genoa7900:if (hi(md)=1) or (hi(md)=2) then ok:=false;
                         else
                           if (md=$53E) or (hi(md)=1) then ok:=false;
                         end;
               else if (md=$53E) or (hi(md)=1) then ok:=false;
               end;
        end;
        byt  :=MODELIST[x].size;
        if (byt>0) then bytes:=byt;
        mreq:=(longint(bytes*planes)*yres+1023) div 1024;
        if ok and (cv.mm>=mreq) then
          addmode(md,xres,yres,bytes,memmode);
      end;
    for x:=1 to noumodes do  {User overrides (.CFG)}
      if usermodes[x].flags=cv.chip then
        if usermodes[x].memmode=__None then
        begin
          for xres:=1 to nomodes do
            if modetbl[xres].md=usermodes[x].md then
              modetbl[xres].flags:=0;    {Disable}
        end
        else addmode(usermodes[x].md,usermodes[x].xres,usermodes[x].yres
                    ,usermodes[x].bytes,usermodes[x].memmode);
  end;
end;


procedure findPCI;
const ROMs:array[0..3] of string[4]=(' 32K',' 64K','128K','256K');
var
  i,j:word;
  PCIid:longint;
  tmp:longint;

procedure wrPCI(txt:string;base:longint);
begin
  write('      '+txt+': '+hex8(base)+'  at ');
  if (base and 1)>0 then write('I/O: '+hex4(base and $FF00)+'h')
  else write('Mem: '+hex8(base and $FFFFFF00)+'h (',base shr 20,'M)');
  if (base and 8)>0 then write(' Cachable');
  writeln;
end;

begin
  PCItype:=0;
  outp($CF8,0);
  outp($CFA,0);
  if (inp($CF8)=0) and (inp($CFA)=0) then PCItype:=2
  else begin
    tmp:=inplong($CF8);
    for i:=1 to 10 do;  {delay}
    outplong($CF8,$80000000);
    for i:=1 to 10 do;
    if inplong($CF8)=$80000000 then PCItype:=1;
    for i:=1 to 10 do;
    outplong($CF8,tmp);
  end;
  if PCItype>0 then
  begin
    clrscr;
    Writeln('PCI bus type ',PCItype,' Devices:');
    writeln(' Bus: Vendor: Device:');
    case PCItype of
      1:begin   {PCI type 1}
          for i:=0 to 127{511} do
          begin
            outplong($CF8,$80000000+i*longint(2048));
            tmp:=inplong($CFC);
            if (word(tmp)<>$FFFF) and ((tmp shr 16)<>$FFFF) then
            begin
              inc(PCIdevs);
              PCIrec[PCIdevs].PCIbase:=i;
              PCIrec[PCIdevs].l[0]:=tmp;
              for j:=1 to 63 do
              begin
                outplong($CF8,$80000000+i*longint(2048)+j*4);
                PCIrec[PCIdevs].l[j]:=inplong($CFC);
              end;
              if PCIrec[PCIdevs].class<>$300 then dec(PCIdevs);
            end;
          end;
        end;
      2:begin   {PCI type 2}
          outp($CF8,$80);
          outp($CFA,0);   {Bus select?}
          for i:=0 to 15 do
          begin
            tmp:=inplong($C000+i*256);
            if (word(tmp)<>$FFFF) and ((tmp shr 16)<>$FFFF) then
            begin
              inc(PCIdevs);
              PCIrec[PCIdevs].PCIbase:=i;
              PCIrec[PCIdevs].l[0]:=tmp;
              for j:=1 to 63 do PCIrec[PCIdevs].l[j]:=inplong($C000+i*256+j*4);
              if PCIrec[PCIdevs].class<>$300 then dec(PCIdevs);
            end;
          end;
          outp($CF8,0);
        end;
    end;
    if PCIdevs>0 then
    begin
      settextmode;
      for i:=1 to PCIdevs do
      begin
        writeln('  Vendor: '+hex4(PCIrec[i].vendor)+'  Device: '+hex4(PCIrec[i].device));
        if PCIrec[i].base0<>0 then wrPCI('Base0',PCIrec[i].base0);
        if PCIrec[i].base1<>0 then wrPCI('Base1',PCIrec[i].base1);
        if PCIrec[i].base2<>0 then wrPCI('Base2',PCIrec[i].base2);
        if PCIrec[i].base3<>0 then wrPCI('Base3',PCIrec[i].base3);
        if PCIrec[i].base4<>0 then wrPCI('Base4',PCIrec[i].base4);
        if PCIrec[i].base5<>0 then wrPCI('Base5',PCIrec[i].base5);
        if PCIrec[i].rom<>0   then wrPCI('ROM  ',PCIrec[i].rom);

        writeln;
      end;
      if readkey='' then;
    end;
  end;
end;


 {Checks for a PCI card with ID=sign, returns index in PCIrec, 0 if not found
  START is the }
function CheckPCI(start,vendor,device:word):integer;
var i:integer;
begin
  i:=start;
  repeat inc(i);
  until (i>PCIdevs) or ((PCIrec[i].vendor=vendor) and
      ((PCIrec[i].device=device) or (device=$FFFF)));
  if i<=PCidevs then CheckPCI:=i
                else CheckPCI:=0;  {Default: None found}
end;

procedure wPCIbyte(index,val:word);
begin
  case PCItype of
    1:begin
        outplong($CF8,$80000000+PCIrec[cv.PCIid].PCIbase*longint(2048)+index);
        outp($CFC,val);
      end;
    2:begin
        outp($CF8,$80);
        outp($CFA,0);   {Bus select?}
        outp($C000+PCIrec[cv.PCIid].PCIbase*256+index,val);
        outp($CF8,0);
      end;
  end;
end;

procedure wPCIword(index,val:word);
begin
  case PCItype of
    1:begin
        outplong($CF8,$80000000+PCIrec[cv.PCIid].PCIbase*longint(2048)+index);
        outpw($CFC,val);
      end;
    2:begin
        outp($CF8,$80);
        outp($CFA,0);   {Bus select?}
        outpw($C000+PCIrec[cv.PCIid].PCIbase*256+index,val);
        outp($CF8,0);
      end;
  end;
end;

procedure wPCIlong(index:word;val:longint);
begin
  case PCItype of
    1:begin
        outplong($CF8,$80000000+PCIrec[cv.PCIid].PCIbase*longint(2048)+index);
        outpl($CFC,val);
      end;
    2:begin
        outp($CF8,$80);
        outp($CFA,0);   {Bus select?}
        outpl($C000+PCIrec[cv.PCIid].PCIbase*256+index,val);
        outp($CF8,0);
      end;
  end;
end;

function rPCIbyte(index:word):word;
begin
  case PCItype of
    1:begin
        outplong($CF8,$80000000+PCIrec[cv.PCIid].PCIbase*longint(2048)+index);
        rPCIbyte:=inp($CFC);
      end;
    2:begin
        outp($CF8,$80);
        outp($CFA,0);   {Bus select?}
        rPCIbyte:=inp($C000+PCIrec[cv.PCIid].PCIbase*256+index);
        outp($CF8,0);
      end;
  end;
end;

function rPCIword(index:word):word;
begin
  case PCItype of
    1:begin
        outplong($CF8,$80000000+PCIrec[cv.PCIid].PCIbase*longint(2048)+index);
        rPCIword:=inpw($CFC);
      end;
    2:begin
        outp($CF8,$80);
        outp($CFA,0);   {Bus select?}
        rPCIword:=inpw($C000+PCIrec[cv.PCIid].PCIbase*256+index);
        outp($CF8,0);
      end;
  end;
end;

function rPCIlong(index:word):longint;
begin
  case PCItype of
    1:begin
        outplong($CF8,$80000000+PCIrec[cv.PCIid].PCIbase*longint(2048)+index);
        rPCIlong:=inpl($CFC);
      end;
    2:begin
        outp($CF8,$80);
        outp($CFA,0);   {Bus select?}
        rPCIlong:=inpl($C000+PCIrec[cv.PCIid].PCIbase*256+index);
        outp($CF8,0);
      end;
  end;
end;




    (* Analyse the current mode *)

var
  oldreg:boolean;

function getbios(offs,lnn:word):string;
var s:string;
begin
  s[0]:=chr(lnn);
  move(mem[biosseg:offs],s[1],lnn);
  getbios:=s;
end;


procedure checkmem(mx:word);
var
  fail:boolean;
  ma:array[0..99] of byte;
  x:word;
begin
  memmode:=_p8;

  fail:=true;
  while (mx>1) and fail do
  begin
    setbank(mx-1);
    move(mem[SegA000:0],ma,100);
    for x:=0 to 99 do
      mem[SegA000:x]:=ma[x] xor $aa;
    setbank(mx-1);
    fail:=false;
    for x:=0 to 99 do
      if mem[SegA000:x]<>ma[x] xor $aa then fail:=true;
    move(ma,mem[SegA000:0],100);
    if not fail then
    begin
      setbank((mx shr 1)-1);
      for x:=0 to 99 do
        mem[SegA000:x]:=ma[x] xor $55;
      setbank(mx-1);
      fail:=true;
      for x:=0 to 99 do
        if mem[SegA000:x]<>ma[x] xor $55 then fail:=false;
      move(ma,mem[SegA000:0],100);
    end;
    mx:=mx shr 1;
  end;
  cv.mm:=mx*128;
end;


procedure DumpRegisters;

procedure dumprg(base,start,ende:word;var rg:regblk);
var six,ix:word;
  same:boolean;
begin
  rg.base:=base;
  six:=inp(base);
  outp(base,0);
  ix:=inp(base) xor 255;
  outp(base,255);
  ix:=ix and inp(base);

  if ende=0 then
    if ix>127 then ende:=255
    else if ix>63 then ende:=127
    else if ix>31 then ende:=63
    else if ix>15 then ende:=31
    else if ix>7 then ende:=15
    else ende:=7;
  for ix:=start to ende do
    rg.x[ix]:=rdinx(base,ix);
  rg.nbr:=ende;
  outp(base,six);
  same:=true;
  while (rg.nbr>7) and same do    {Check for doubles}
  begin
    six:=succ(rg.nbr) div 2;
    for ix:=0 to six-1 do
      if rg.x[ix]<>rg.x[ix+six] then same:=false;
    if same then rg.nbr:=rg.nbr div 2;
  end;

end;

procedure DumpTridOldRegs;
begin
  wrinx(SEQ,$B,0);
  rgs.tridold0d:=rdinx(SEQ,$D);
  rgs.tridold0e:=rdinx(SEQ,$E);
  if rdinx(SEQ,$B)=0 then;  {New mode}
  oldreg:=true;
end;

procedure DumpXGAregs;
var x:word;
begin
  dumprg(cv.IOadr+10,0,0,rgs.xxregs);
  for x:=0 to 15 do
    rgs.xgaregs[x]:=inp(cv.IOadr+x);
end;

var x,y,m:word;
  VESAcheat:boolean;
begin
  if cv.chip=__VESA then
  begin
    cv.chip:=__Alli;
    cv.ioadr:=$1ce;
    cv.dactype:=_dacSTG1703;
    VESAcheat:=true;
  end
  else VESAcheat:=false;
  case cv.chip of  { Enable ext }
     __S3:begin
        wrinx(crtc,$38,$48);
        wrinx(crtc,$39,$A5);
            if (cv.version=S3_732) or (cv.Version=S3_764) then wrinx(SEQ,8,6);
      end;
   __Trid:begin
            outpw(SEQ,$B);
            if inp(SEQ+1)=0 then;
            x:=rdinx(SEQ,$E) XOR 2;
            outp(SEQ+1,x OR $80);   {Enable extended registers}
          end;
 __Compaq:wrinx(GRC,$F,5);
 {__Video7:wrinx(SEQ,6,$EA); }
  end;
  fillchar(rgs,sizeof(rgs),0);
  oldreg:=false;
  vclk:=0;
  for x:=$3C2 to $3DF do rgs.stdregs[x]:=inp(x);
  rgs.stdregs[$3DA]:=inp(CRTC+6);
  rgs.stdregs[$3C0]:=inp($3C0);
  for x:=0 to 31 do rgs.attregs[x]:=rdinx($3C0,x);
  x:=rdinx($3C0,$30);
  rgs.mode:=curmode;
  dumprg(CRTC,0,0,rgs.crtcregs);
  dumprg(SEQ,0,0,rgs.seqregs);
  dumprg(GRC,0,0,rgs.grcregs);
  case cv.chip of
   __Alli:begin
            if mem[SegA000:$D8]=0 then;
            outpw(SEQ,$1210);
            setinx(SEQ,$1C,8);
            modinx(SEQ,$1B,7,1);

            rgs.xxregs.nbr:=255;
            rgs.xxregs.base:=1;
            move(mem[SegA000:0],rgs.xxregs.x,256);
            clrinx(SEQ,$1B,7);
            clrinx(SEQ,$1C,8);
          end;
    __ati:begin
            dumprg(cv.IOadr,$A0,$BF,rgs.xxregs);
            rgs.xxregs.x[0]:=inp($6AEC);
            rgs.xxregs.x[1]:=inp($6AED);
            rgs.xxregs.x[2]:=inp($6AEE);
            rgs.xxregs.x[3]:=inp($6AEF);
            rgs.xxregs.x[4]:=inp($72EC);
            rgs.xxregs.x[5]:=inp($72ED);
            rgs.xxregs.x[6]:=inp($72EE);
            rgs.xxregs.x[7]:=inp($72EF);
            rgs.xxregs.x[8]:=inp($62EC);
            rgs.xxregs.x[9]:=inp($62ED);
            rgs.xxregs.x[10]:=inp($62EE);
            rgs.xxregs.x[11]:=inp($62EF);
            rgs.xxregs.x[12]:=inp($1EEC);
            rgs.xxregs.x[13]:=inp($1EED);
            rgs.xxregs.x[14]:=inp($1EEE);
            rgs.xxregs.x[15]:=inp($1EEF);
          end;
  __chips:dumprg(cv.IOadr,0,0,rgs.xxregs);
   __VESA,
 __compaq:begin
        for x:=1 to 15 do
          for m:=0 to 15 do
        rgs.xxregs.x[(x-1)*16+m]:=inp(x*$1000+$3C0+m);
        rgs.xxregs.base:=$3C;
        rgs.xxregs.nbr:=240;
      end;
     __WD:if cv.Version=WD_90c24 then
            begin
              wrinx(SEQ,$35,$50);  {Unlock clock regs}
              rgs.seqregs.x[$31]:=rdinx(SEQ,$31);
              wrinx(crtc,$34,$A6);
              wrinx(crtc,$35,$30);
              for x:=$31 to $3F do
                rgs.crtcregs.x[x]:=rdinx(crtc,x);
              wrinx(crtc,$34,0);
              wrinx(crtc,$35,0);
            end;
   __Mach64:begin
              move(mem[cv.Xseg:0],rgs.xxregs.x,256);
              rgs.xxregs.x[$D4]:=inp($6AEC);
              rgs.xxregs.x[$D5]:=inp($6AED);
              rgs.xxregs.x[$D6]:=inp($6AEE);
              rgs.xxregs.x[$D7]:=inp($6AEF);
              rgs.xxregs.base:=$2EC;
              rgs.xxregs.nbr:=256;
            end;
   __Mach32:begin
            rgs.xxregs.base:=$2E8;
            rgs.xxregs.nbr:=128;
            for x:=0 to 63 do    {Mach8 & 32}
            begin
              m:=inpw($2E8+(x shl 10));
              rgs.xxregs.x[x*2]:=lo(m);
              rgs.xxregs.x[x*2+1]:=hi(m);
            end;
            if cv.Version>=ATI_GUP_3 then  {Mach32}
            begin
              for x:=0 to 63 do
              begin
                m:=inpw($2EE+(x shl 10));
                rgs.xxregs.x[x*2+128]:=lo(m);
                rgs.xxregs.x[x*2+129]:=hi(m);
              end;
              rgs.xxregs.nbr:=256;
            end;
          end;
  __Tseng:if cv.version>=ET_4W32 then dumprg($217A,0,0,rgs.xxregs);
    __hmc:dumprg(SEQ,$0,$FF,rgs.xxregs);
    __Matrox,
    __oak:dumprg($3DE,0,0,rgs.xxregs);
   __trid:DumpTridOldRegs;
 (*   __agx:if (inp(cv.IOadr) and 4)=0 then DumpTridOldRegs
      else DumpXGAregs;  *)
    __AGX,__xbe,__xga:
          DumpXGAregs;
  else rgs.xxregs.base:=0;
  end;

  for x:=0 to 15 do
    rgs.dacregs[x]:=rdDACreg(x);
  if (DACflags and DFL_CmdReg)>0 then
  begin
    dac2comm;
    rgs.dacregs[16]:=inp($3C6);
    dac2pel;
  end;
  rgs.dacinxd.nbr :=0;
  rgs.dacinxd.base:=0;
  case cv.dactype of
_dacCL5200:begin
             outp($3C6,0);
             dac2comm;
             rgs.dacregs[6]:=inp($3C6);
             dac2pel;
             outp($3C6,rgs.dacregs[2]);
           end;
_dacMU1880:begin
             dac2comm;
             dac2comm;
             x:=8;
             while (x>0) and (inp($3C6)<>$8E) do dec(x);
             rgs.dacinxd.x[6]:=inp($3C6);
             rgs.dacinxd.x[6]:=inp($3C6);
             dac2pel;

           end;
 _dacSC15021,_dacSc15025:
           begin    {Sierra SC15025 24bit DAC}
             y:=inp(SetDACpage(dacHIcmd));
             outp(SetDACpage(dacHIcmd),y or 16);
             dumprg($3C7,0,31,rgs.dacinxd);
             outp(SetDACpage(dacHIcmd),y);
           end;
 _dacSTG1700,_dacSTG1702,_dacSTG1703:
           begin
             rgs.dacinxd.base:=$3C6;
             rgs.dacinxd.nbr:=7;
             y:=inp(SetDACpage(dacHIcmd));
             outp(SetDACpage(dacHIcmd),y or 16);
             dac2comm;
             m:=inp($3C6);
             outp($3C6,0);
             outp($3C6,0);
             for x:=0 to 7 do
               rgs.dacinxd.x[x]:=inp($3C6);
             if cv.dactype=_dacSTG1703 then
             begin
               for x:=8 to $5F do
                 rgs.dacinxd.x[x]:=inp($3C6);
               rgs.dacinxd.nbr:=$5F;
             end;
             wrDACreg(dacHIcmd,y);
           end;
 _dacBt481,_dacBt482:
           begin
             if cv.chip=__AGX then outp(cv.IOadr,1);
           (*  outp(SetDACpage(dacBT1cmdA),1);
             for x:=0 to 15 do {This screws up the DAC, so we drop it for now}
             begin
               outp($3C8,x);
               rgs.dacinxd.x[x]:=inp($3C6);
             end;
             rgs.dacinxd.base:=$3C6;
             rgs.dacinxd.nbr:=15;
             outp(SetDACpage(dacBT1cmdA),rgs.dacregs[dacBT1cmdA]); *)
             if cv.chip=__AGX then outp(cv.IOadr,4);
           end;
 _dacBt484,_dacBt485,_dacATT504,_dacATT505:
           begin    {BrookTree Bt484/5 or ATT20c504/5 DAC}
             outp(SetDACpage(dacBTcmd0),rgs.dacregs[dacBTcmd0] or $80);
             outp(SetDACpage(0),0);
             rgs.dacregs[dacBTstat]:=inp(SetDACpage(dacBTstat));
             outp(SetDACpage(0),1);
             rgs.dacregs[16]:=inp(SetDACpage(dacBTstat));
             outp(SetDACpage(dacBTcmd0),rgs.dacregs[dacBTcmd0]);
           end;
_dacCH8391,
_dacCH8398:begin
             outp(SetDACpage(7),0);
             for x:=1 to 4 do y:=inp(SetDACpage(4));
             rgs.dacregs[16]:=inp(SetDACpage(4));
             outp(SetDACpage(7),0);
             for x:=0 to 47 do rgs.dacinxd.x[x]:=inp(SetDACpage(5));
             rgs.dacinxd.base:=$3C8;
             rgs.dacinxd.nbr :=47;
           end;
 _dacS3_708,_dacS3_716:
           begin  {S3 SDAC and GenDAC}
             outp(SetDACpage(7),0);
             for x:=0 to 31 do  {There are 16 16bit registers}
             begin
               {outp(SetDACpage(7),x);}
               rgs.dacinxd.x[x]:=inp(SetDACpage(5));
             end;
             rgs.dacinxd.base:=$3C6;
             rgs.dacinxd.nbr:=31;
           end;
 _dacTVP3010,_dacTVP3020,_dacTVP3025:
           begin    {TI TVP 302x DAC}
             y:=rdDACreg(dacTVPindex);
             for y:=0 to $3F do
             begin
               wrDACreg(dacTVPindex,y);
               rgs.dacinxd.x[y]:=rdDACreg(dacTVPdata);
             end;

             wrDACreg(dacTVPindex,$2C);
             wrDACreg(dacTVPdata,0);  {PLL 1st byte}
             wrDACreg(dacTVPindex,$2D);
             rgs.dacinxd.x[$40]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVP6index,$2E);
             rgs.dacinxd.x[$43]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2F);
             rgs.dacinxd.x[$46]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2C);
             wrDACreg(dacTVPdata,1);  {PLL 2nd byte}
             wrDACreg(dacTVPindex,$2D);
             rgs.dacinxd.x[$41]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2E);
             rgs.dacinxd.x[$44]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2F);
             rgs.dacinxd.x[$47]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2C);
             wrDACreg(dacTVPdata,2);  {PLL 3rd byte}
             wrDACreg(dacTVPindex,$2D);
             rgs.dacinxd.x[$42]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2E);
             rgs.dacinxd.x[$45]:=rdDACreg(dacTVPdata);
             wrDACreg(dacTVPindex,$2F);
             rgs.dacinxd.x[$48]:=rdDACreg(dacTVPdata);
             rgs.dacinxd.nbr:=$48;
             rgs.dacinxd.base:=$3C6;
             wrDACreg(dacTVP6index,y);
           end;
 _dacTVP3026:
           begin    {TI TVP 3026 DAC}
             y:=rdDACreg(dacTVP6index);
             for y:=0 to $3F do
             begin
               wrDACreg(dacTVP6index,y);
               rgs.dacinxd.x[y]:=rdDACreg(dacTVP6data);
             end;

             wrDACreg(dacTVP6index,$2C);
             wrDACreg(dacTVP6data,0);  {PLL 1st byte}
             wrDACreg(dacTVP6index,$2D);
             rgs.dacinxd.x[$40]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2E);
             rgs.dacinxd.x[$43]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2F);
             rgs.dacinxd.x[$46]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2C);
             wrDACreg(dacTVP6data,1);  {PLL 2nd byte}
             wrDACreg(dacTVP6index,$2D);
             rgs.dacinxd.x[$41]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2E);
             rgs.dacinxd.x[$44]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2F);
             rgs.dacinxd.x[$47]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2C);
             wrDACreg(dacTVP6data,2);  {PLL 3rd byte}
             wrDACreg(dacTVP6index,$2D);
             rgs.dacinxd.x[$42]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2E);
             rgs.dacinxd.x[$45]:=rdDACreg(dacTVP6data);
             wrDACreg(dacTVP6index,$2F);
             rgs.dacinxd.x[$48]:=rdDACreg(dacTVP6data);
             rgs.dacinxd.nbr:=$48;
             rgs.dacinxd.base:=$3C6;
             wrDACreg(dacTVP6index,y);
           end;
_dacMU9910:begin
             rgs.dacinxd.base:=$83C9;
             rgs.dacinxd.nbr:=$1F;
             outp(SetDACpage(7),0);
             for y:=0 to $1F do
               rgs.dacinxd.x[y]:=inp(SetDACpage(5));
           end;
_dacIBM514,_dacIBM524,_dacIBM525,_dacIBM528:
           begin
             rgs.dacinxd.base:=$3C6;
             rgs.dacinxd.nbr:=255;

           (*  wrDACreg(dacIBMind1,0);
             for x:=0 to 255 do
             begin
               wrDACreg(dacIBMind0,x);
               rgs.dacinxd.x[x]:=rdDACreg(dacIBMdata);
             end;
             wrDACreg(dacIBMind0,rgs.dacregs[dacIBMind0]); *)
           end;
  end;
  clearDACpage;
  case cv.chip of  { Disable ext }
     __S3:begin
            if (cv.version=S3_732) or (cv.Version=S3_764) then
              wrinx(SEQ,8,rgs.seqregs.x[8]);
        wrinx(crtc,$38,0);
        wrinx(crtc,$39,$5A);
      end;
   __Trid:if cv.version>=TR_GUI9440 then
          begin
            setinx(SEQ,$C,$60);
            rgs.dacregs[ 8]:=inp($43C8);
            rgs.dacregs[ 9]:=inp($43C9);
            rgs.dacregs[10]:=inp($43C6);
            rgs.dacregs[11]:=inp($43C7);
            wrinx(SEQ,$C,rgs.seqregs.x[$C]);
          end;
  end;
  if VESAcheat then cv.chip:=__VESA;
end;

procedure CalcRegisters;
{const
  wd24clk:array[0..15] of real=(29.979,77.408,0,80.092,25.175,28.322
          ,65,36,39.822,50.114,42.060,44.297,31.5,35.501,75.166,50.114); }
var x,m,wid,wordadr,pixwid,clksel,vclkdiv:word;
    force256,graph,isilace:boolean;
    hfreqfact:word;

  VESAcheat,
  SerialDAC:boolean;     {If set the DAC takes one byte at a time}
begin
  if cv.chip=__VESA then
  begin
    cv.chip:=__Alli;
    VESAcheat:=true;
  end
  else VESAcheat:=false;
  SerialDAC:=true;
  m:=rgs.grcregs.x[6];
  case (m shr 2) and 3 of
  0,1:calcvseg:=SegA000;
    2:calcvseg:=SegB000;
    3:calcvseg:=SegB800;
  end;
  clksel:=(rgs.stdregs[$3CC] shr 2) and 3;
  vclkdiv:=12;     {Base 12.}
  begin
    ilace:=false;
    isilace:=false;  {Interlaced, but do not double lines!!}
    extpixfact:=1;
    extlinfact:=1;

    hfreqfact:=1;
    calclines:=rgs.crtcregs.x[$12]+1;
    pixwid:=8;
    calcpixels:=rgs.crtcregs.x[1]+1;
    force256:=false;
    calchtot:=rgs.crtcregs.x[0]+5;
    calcvtot:=rgs.crtcregs.x[6]+2;

    calchblks:=rgs.crtcregs.x[2];
    calchrtrs:=rgs.crtcregs.x[4];
    calchblke:=rgs.crtcregs.x[3] and 31;
    calchrtre:=rgs.crtcregs.x[5] and 31;
    hrtrmask:=$1F;   {Retrace and blanking masks (valid bits)}
    hblkmask:=$3F;
    calcvblks:=rgs.crtcregs.x[$15];
    calcvrtrs:=rgs.crtcregs.x[$10];
    calcvblke:=rgs.crtcregs.x[$16] and 127;
    calcvrtre:=rgs.crtcregs.x[$11] and 15;
    vblkmask:=$7F;
    vrtrmask:=$F;

    if (rgs.crtcregs.x[7] and   1)>0 then inc(calcvtot, 256);
    if (rgs.crtcregs.x[7] and   2)>0 then inc(calclines,256);
    if (rgs.crtcregs.x[7] and   4)>0 then inc(calcvrtrs,256);
    if (rgs.crtcregs.x[7] and   8)>0 then inc(calcvblks,256);
    if (rgs.crtcregs.x[7] and $20)>0 then inc(calcvtot, 512);
    if (rgs.crtcregs.x[7] and $40)>0 then inc(calclines,512);
    if (rgs.crtcregs.x[7] and $80)>0 then inc(calcvrtrs,512);
    if (rgs.crtcregs.x[5] and $80)>0 then inc(calchblke, 32);
    if (rgs.crtcregs.x[9] and $20)>0 then inc(calcvblks,512);

    if (rgs.seqregs.x[1] and 8)>0 then vclkdiv:=vclkdiv*2;

    graph:=(rgs.attregs[$10] and 1)>0;
    if graph then
    begin
      extlinfact:=(rgs.crtcregs.x[9] and $1F)+1;
      if (rgs.crtcregs.x[9] and $80)>0 then extlinfact:=extlinfact*2;
    end
    else begin
      if {((rgs.attregs[$10] and 4)>0) or} ((rgs.seqregs.x[1] and 1)=0) then charwid:=9 else charwid:=8;
      charhigh:=(rgs.crtcregs.x[9] and $1f)+1;
    end;

    wid:=rgs.crtcregs.x[$13];
    wordadr:=2;
    if (rgs.crtcregs.x[$14] and 64)<>0 then wordadr:=8
    else if (rgs.crtcregs.x[$17] and 64)=0 then wordadr:=4;
    case cv.chip of
      __Acer:wid:=wid+(rgs.crtcregs.x[$81] and 3) shl 8;
       __AGX:begin
           calcpixels:=rgs.xxregs.x[$13]*256+rgs.xxregs.x[$12]+1;
           calchtot:=rgs.xxregs.x[$11]*256+rgs.xxregs.x[$10]+1;
           pixwid:=8;
           calclines :=rgs.xxregs.x[$23]*256+rgs.xxregs.x[$22]+1;
           calcvtot:=rgs.xxregs.x[$21]*256+rgs.xxregs.x[$20]+1;
           wid :=rgs.xxregs.x[$44]*256+rgs.xxregs.x[$43];
           wordadr:=8;
               vclkdiv:=12;  {Nominal}
               if (rgs.xxregs.x[$50] and 8)>0 then ilace:=true;
         end;
     __ahead:begin
           if (rgs.grcregs.x[$1c] and 12)=12 then ilace:=true;
           if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=16;
         end;
       __ALG:begin
           if (rgs.grcregs.x[$C] and $10)>0 then wordadr:=wordadr shl 1
               else if (rgs.crtcregs.x[$14] and 64)>0 then  {Packed mode}
               begin
                 pixwid:=4;
                 vclkdiv:=vclkdiv*2;
               end;
           if (rgs.crtcregs.x[$19] and 1)>0 then
           begin
         ilace:=true;
         wordadr:=wordadr shr 1;
           end;
               if (cv.version>ALG_2101) and ((rgs.crtcregs.x[$19] and $80)>0) then
               begin
                 if (rdinx(crtc,$2A) and 1)>0 then inc(calchtot,256);
                 if (rdinx(crtc,$28) and $80)>0 then inc(wid,256);
               end;
         end;
      __Alli:begin
               if (rgs.grcregs.x[5] and $40)>0 then
               begin
                 force256:=true;
                 wordadr:=8;
               end;
               inc(wid,(rgs.crtcregs.x[$1C] shr 4)*256);
               if (rgs.crtcregs.x[$1A] and 1)>0 then inc(calcvtot,1024);
               if (rgs.crtcregs.x[$1A] and 2)>0 then inc(calclines,1024);
               if (rgs.crtcregs.x[$1A] and 4)>0 then inc(calcvrtrs,1024);
               if (rgs.crtcregs.x[$1A] and 8)>0 then inc(calcvblks,1024);
               if (rgs.crtcregs.x[$1B] and 1)>0 then inc(calchtot,256);
               if (rgs.crtcregs.x[$1B] and 4)>0 then inc(calchblks,256);
               if (rgs.crtcregs.x[$1B] and 8)>0 then inc(calchrtrs,256);
             end;
       __ARK:begin
               if (rgs.crtcregs.x[$44] and 4)>0 then ilace:=true;
               if (rgs.crtcregs.x[$41] and 128)>0 then inc(calchtot,256);
               if (rgs.crtcregs.x[$41] and  64)>0 then inc(calcpixels,256);
               if (rgs.crtcregs.x[$41] and  32)>0 then inc(calchblks,256);
               if (rgs.crtcregs.x[$41] and  16)>0 then inc(calchrtrs,256);
               if (rgs.crtcregs.x[$41] and   8)>0 then inc(wid,256);
               if (rgs.crtcregs.x[$40] and 128)>0 then inc(calcvtot,1024);
               if (rgs.crtcregs.x[$40] and  64)>0 then inc(calclines,1024);
               if (rgs.crtcregs.x[$40] and  32)>0 then inc(calcvblks,1024);
               if (rgs.crtcregs.x[$40] and  16)>0 then inc(calcvrtrs,1024);
             end;
       __ati:begin
               if cv.Version=ATI_18800 then
               begin
                 if (rgs.xxregs.x[$B2] and 1)<>0 then ilace:=true;
               end
             else if (rgs.xxregs.x[$BE] and 2)<>0 then ilace:=true;
           if (rgs.xxregs.x[$B0] and $20)>0 then
           begin
         force256:=true;
         if cv.Version=ATI_18800 then wordadr:=8
                                         else wordadr:=16;
           end;
               if ((rgs.xxregs.x[$B3] and $40)>0) and (cv.Version>ATI_18800) then
               begin
                 pixwid:=pixwid*2;
                 wordadr:=wordadr*2;
               end;
               if ((rgs.xxregs.x[$B6] and $10)>0) and ((cv.version<ATI_GUP_3)
                   or (cv.Version>=ATI_M64_GX)) then
               begin
                 force256:=false;
               end;
               if ((rgs.xxregs.x[$B1] and $40)>0) then
               begin
                 calclines:=calclines div 2;
                 calcvtot:=calcvtot div 2;
               end;
               if ((rgs.seqregs.x[4] and 8)>0) and not force256 then
                  pixwid:=pixwid*2;   {Mode 65h (PK4) fix}


               if (cv.Version=ATI_28800_6) and ((rgs.xxregs.x[$AD] and 8)>0) then
               begin
                 if (rgs.xxregs.x[$AD] and 1)>0 then inc(calchtot,256);
                 if (rgs.xxregs.x[$AD] and 2)>0 then inc(calchblks,256);
                 if (rgs.xxregs.x[$AD] and 4)>0 then inc(calchrtrs,256);
               end;
         end;
     __chips:begin
           if (rgs.xxregs.x[$D] and 1)<>0 then inc(wid,256);
               if (rgs.xxregs.x[$17] and 1)>0 then inc(calchtot,256);
               if (rgs.xxregs.x[$D] and 4)>0 then inc(wid,256);
           if (rgs.xxregs.x[$B] and 4)>0 then
           begin
                 force256:=true;
         wordadr:=8;
             if cv.version<CT_65520 then
                 begin
                   pixwid:=4;
                   vclkdiv:=vclkdiv*2;
                 end;
           end;
               if (rgs.xxregs.x[$28] and $20)>0 then ilace:=true;
         end;
     __cir54:begin
           if (rgs.seqregs.x[4] and 8)>0 then wordadr:=8;
           if (rgs.crtcregs.x[$1B] and 16)>0 then inc(wid,256);
           if (rgs.crtcregs.x[$1A] and 1)>0 then ilace:=true;
               if (rgs.crtcregs.x[$1B] and $80)>0 then
               begin
                 inc(calchblke,(rgs.crtcregs.x[$1A] and $30) shl 2);
                 hblkmask:=$FF;
                 calcvblke:=rgs.crtcregs.x[$16]+((rgs.crtcregs.x[$1A] and $C0) shl 2);
                 vblkmask:=$3FF;
               end;
         end;
     __cir64:begin
           if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=8;
           if (rgs.grcregs.x[$82] and 7)=2 then pixwid:=4;
           if (rgs.grcregs.x[$79] and  1)>0 then inc(calchtot,1024);
           if (rgs.grcregs.x[$79] and  2)>0 then inc(calclines,1024);
           if (rgs.grcregs.x[$79] and 16)>0 then inc(calchrtrs,1024);
               inc(calchblks,(rgs.grcregs.x[$79] and $C) shl 7);
         end;
    __compaq:begin
           if (rgs.grcregs.x[$F] and $F0)=0 then wordadr:=8;
               inc(wid,(rgs.grcregs.x[$42] and 3)*256);
           if (rgs.crtcregs.x[$14] and 64)>0 then pixwid:=4;
               if (rgs.grcregs.x[$51] and $40)>0 then inc(calcvtot,1024);
               if (rgs.grcregs.x[$51] and $80)>0 then inc(calcvrtrs,1024);
              { if (rgs.grcregs.x[$51] and $20)>0 then inc(calchrtre,32);
               hrtrmask:=$3F; }
               if cv.version>CPQ_QV then
               begin
                 SerialDAC:=false;   {Dirty Hack!!}
                 if memmode>=_PK4 then pixwid:=pixwid shr 2;
               end;
         end;
     __genoa:begin
               if (rgs.crtcregs.x[$2F] and 1)<>0 then ilace:=true;
               if (rgs.crtcregs.x[$2F] and 2)<>0 then wordadr:=16;
               if (rgs.seqregs.x[4] and 8)>0 then pixwid:=4;
             end;
       __hmc:begin
               IF (rgs.xxregs.x[$E7] and 1)>0 then ilace:=true;
               if (rgs.xxregs.x[$E7] and 2)>0 then force256:=true;
              { if (rgs.xxregs.x[$E7] and 64)>0 then inc(clksel,4);
               vclk:=HMCclk[clksel]; }
             end;
    __Mach32:begin
               calcpixels:=rgs.xxregs.x[$D8]+1;   {B2EE}
               calchtot  :=rgs.xxregs.x[$D9]+1;   {B2EF}
               calcvtot  :=(rgs.xxregs.x[$E0]+rgs.xxregs.x[$E1]*256)+1; {C2EE}
               calclines :=(rgs.xxregs.x[$E2]+rgs.xxregs.x[$E3]*256)+1; {C6EE}
               calchrtrs :=rgs.xxregs.x[$DA];   {B6EE}
               calchrtre :=calchrtrs+(rgs.xxregs.x[$DC] and $1F);   {BAEE}
               calcvrtrs :=(rgs.xxregs.x[$E4]+rgs.xxregs.x[$E5]*256)+1; {CAEE}
               calcvrtre :=calcvrtrs+(rgs.xxregs.x[$E8] and $1F);   {D2EE}
               pixwid:=8;
               case rgs.xxregs.x[$C6] and $30 of   {8EEE}
                   0:calcmmode:=_pk4;
                 $10:calcmmode:=_p8;
                 $20:case rgs.xxregs.x[$C6] and $C0 of
                        0:calcmmode:=_p15;
                      $40:calcmmode:=_p16;
                     end;
                 $30:case rgs.xxregs.x[$C7] and 6 of
                       0:calcmmode:=_p24;
                       2:calcmmode:=_p32c;
                       4:calcmmode:=_p24b;
                       6:calcmmode:=_p32b;
                     end;
               end;
               {There is no way to determine the bytes/scanline (Write only)}
             end;
    __Mach64:begin
               calchtot  :=(rgs.xxregs.x[$0]+rgs.xxregs.x[$1]*256)+1;
               calcpixels:=(rgs.xxregs.x[$2]+rgs.xxregs.x[$3]*256)+1;
               calcvtot  :=(rgs.xxregs.x[$8]+rgs.xxregs.x[$9]*256)+1;
               calclines :=(rgs.xxregs.x[$A]+rgs.xxregs.x[$B]*256)+1;
               wid       :=(rgs.xxregs.x[$16]+rgs.xxregs.x[$17]*256) shr 6;
               calchrtrs :=rgs.xxregs.x[$4];
               calchrtre :=calchrtrs+(rgs.xxregs.x[$6] and $1F);
               calcvrtrs :=(rgs.xxregs.x[$C]+rgs.xxregs.x[$D]*256)+1;
               calcvrtre :=calcvrtrs+(rgs.xxregs.x[$E] and $1F);
               pixwid:=8;
               calcmmode:=_P8;
               if (rgs.xxregs.x[$1C] and 2)>0 then ilace:=true;
               case rgs.xxregs.x[$1D] and 7 of
                 1:calcmmode:=_PK4;
                 2:calcmmode:=_P8;
                 3:calcmmode:=_P15;
                 4:calcmmode:=_P16;
                 5:calcmmode:=_P24;
                 6:calcmmode:=_P32;
               end;
               wordadr:=usebits[calcmmode];
               SerialDAC:=false;
             end;
    __Matrox:begin
               if (rgs.xxregs.x[$D] and $40)>0 then
               begin
                 ilace:=true;
                 if (rgs.xxregs.x[1] and 8)=0 then   {not Ext 256c}
                   wordadr:=wordadr shr 1;
               end;
               if (rgs.xxregs.x[1] and 8)>0 then   {Ext 256c}
                 wordadr:=wordadr shl 2;

             end;
      __mxic:if (rgs.seqregs.x[$F0] and 3)=3 then ilace:=true;
       __NCR:begin
           if (rgs.seqregs.x[$20] and 2)<>0 then
           begin
         force256:=true;
         wordadr:=8;
           end;
           if (rgs.seqregs.x[$1F] and $10)<>0 then
         case rgs.seqregs.x[$1F] and 15 of
           0:pixwid:=4;
          11:pixwid:=16;
         else pixwid:=(rgs.seqregs.x[$1F] and 15)+6;
         end;
           if (rgs.crtcregs.x[$30] and $10)<>0 then
           begin
         ilace:=true;
         extlinfact:=1;
           end;
               if (rgs.crtcregs.x[$30] and  1)>0 then inc(calchtot,256);
           if (rgs.crtcregs.x[$30] and  2)>0 then inc(calcpixels,256);
               if (rgs.crtcregs.x[$30] and  4)>0 then inc(calchblks,256);
               if (rgs.crtcregs.x[$30] and  8)>0 then inc(calchrtrs,256);
           if (rgs.crtcregs.x[$31] and 16)>0 then inc(wid,256);
               if cv.version>=NCR_77c22Ep then
               begin
                 if (rgs.crtcregs.x[$32] and 1)>0 then inc(calchtot,512);
                 if (rgs.crtcregs.x[$32] and 2)>0 then inc(calcpixels,512);
                 if (rgs.crtcregs.x[$32] and 4)>0 then inc(calchblks,512);
                 if (rgs.crtcregs.x[$32] and 8)>0 then inc(calchrtrs,512);
                 if (rgs.crtcregs.x[$33] and 1)>0 then inc(calcvtot,1024);
                 if (rgs.crtcregs.x[$33] and 2)>0 then inc(calclines,1024);
                 if (rgs.crtcregs.x[$33] and 4)>0 then inc(calcvblks,1024);
                 if (rgs.crtcregs.x[$33] and 8)>0 then inc(calcvrtrs,1024);
                 if (rgs.crtcregs.x[$30] and 32)>0 then
                 begin
                   inc(calchblke,(rgs.crtcregs.x[$32] and $30) shl 2);
                   hblkmask:=$FF;
                   inc(calchrtre,(rgs.crtcregs.x[$32] and $C0) shr 1);
                   hrtrmask:=$7F;
                   calcvblke:=rgs.crtcregs.x[$16]+((rgs.crtcregs.x[$33] and $60) shl 3);
                   vblkmask:=$3FF;
                   inc(calchrtre,(rgs.crtcregs.x[$33] and $80) shr 3);
                   vrtrmask:=$1F;
                 end;
               end;
         end;
       __oak:if cv.version<>OAK_037 then
             begin
           if (rgs.xxregs.x[$14] and 128)<>0 then ilace:=true;
               if (rgs.xxregs.x[$14] and 1)>0 then inc(calcvtot,1024);
               if (rgs.xxregs.x[$14] and 2)>0 then inc(calclines,1024);
               if (rgs.xxregs.x[$14] and 4)>0 then inc(calcvrtrs,1024);
               if cv.Version<=OAK_083 then
               begin
                 if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=16;
                      {Cheat for 256 color mode}
               end
               else begin
                 if (rgs.seqregs.x[4] and 8)<>0 then
                   if (rgs.xxregs.x[$21] and 4)>0 then wordadr:=16
                                                  else pixwid:=4;
               end;
         end;
     __p2000:begin
           if (rgs.grcregs.x[$13] and $40)<>0 then
           begin
         wordadr:=wordadr shr 1;
         ilace:=true;
           end;
           if (rgs.grcregs.x[$21] and $20)<>0 then inc(wid,256);
         end;
        __WD:begin
           if (cv.version>=WD_90c00) then
                 if (rgs.crtcregs.x[$2D] and $20)>0 then ilace:=true;
           if (cv.version>=WD_90c30) then
               begin
                 if (rgs.crtcregs.x[$3D] and 1)>0 then inc(calcvtot,1024);
                 if (rgs.crtcregs.x[$3D] and 2)>0 then inc(calclines,1024);
                 if (rgs.crtcregs.x[$3D] and 4)>0 then inc(calcvrtrs,1024);
                 if (rgs.crtcregs.x[$3D] and 8)>0 then inc(calcvblks,1024);
               end;
           if (rgs.seqregs.x[4] and 8)>0 then wordadr:=8;
                      {Cheat for 256 color mode}
         {  if (rgs.grcregs.x[$C] and 2)>0 then inc(clksel,4);
           vclk:=WDclk[clksel];  }
           if (cv.version>=WD_90c33) and ((rgs.crtcregs.x[$3E] and $20)>0) then inc(calchtot,256);
         end;
   __realtek:begin
           if (rgs.seqregs.x[4] and 8)<>0 then
               begin
                 pixwid:=4;
                 hfreqfact:=2;
               end;
           if (rgs.grcregs.x[$C] and $10)<>0 then
           begin
         pixwid:=pixwid*2;
         wid:=wid*2;
           end;
           if (rgs.crtcregs.x[$19] and 1)<>0 then
           begin
         ilace:=true;
         wid:=wid div 2;
           end;
         end;
    __s3:begin
           if (rgs.crtcregs.x[$42] and $20)<>0 then ilace:=true;
           if (rgs.crtcregs.x[$43] and 4)<>0   then inc(wid,256);
           if (rgs.crtcregs.x[$43] and $80)<>0 then pixwid:=pixwid*2;
           if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=8 else wordadr:=2;
           if (rgs.attregs[$10] and 1)=0 then wid:=wid*2;
               if (rgs.crtcregs.x[$3A] and $10)>0 then force256:=true;
               if (cv.Version>S3_924) then
               begin
                 if (rgs.crtcregs.x[$5D] and  1)>0 then inc(calchtot,256);
                 if (rgs.crtcregs.x[$5D] and  2)>0 then inc(calcpixels,256);
                 if (rgs.crtcregs.x[$5D] and  4)>0 then inc(calchblks,256);
                 if (rgs.crtcregs.x[$5D] and 16)>0 then inc(calchrtrs,256);
                 if (rgs.crtcregs.x[$5E] and  1)>0 then inc(calcvtot,1024);
                 if (rgs.crtcregs.x[$5E] and  2)>0 then inc(calclines,1024);
                 if (rgs.crtcregs.x[$5E] and  4)>0 then inc(calcvblks,1024);
                 if (rgs.crtcregs.x[$5E] and 16)>0 then inc(calcvrtrs,1024);
                 if (rgs.crtcregs.x[$51] and $30)>0 then
                   wid:=(wid and $FF)+(rgs.crtcregs.x[$51] and $30) shl 4;
               end;
         end;
        __SC:wid:=wid+(rgs.crtcregs.x[$1E] and $30) shl 4;
       __SiS:begin
               wid:=wid+(rgs.seqregs.x[$A] and $F0) shl 4;
               if (rgs.seqregs.x[6] and $20)>0 then
               begin
                 ilace:=true;
                 wid:=wid shr 1;
               end;
             end;
      __trid:begin
               if memmode>=_P8 then wordadr:=8;   {Req'd for 9440 800x600 16bit}
           if (rgs.tridold0d and 16)<>0 then wordadr:=wordadr*2
           else if cv.version<TR_GUI9440 then
               begin
                 if (rgs.seqregs.x[4] and 8)>0 then pixwid:=pixwid div 2;
                 if memmode>=_p8 then vclkdiv:=vclkdiv*2;
               end;
           if (rgs.crtcregs.x[$1e] and 4)<>0 then
                 if cv.version=TR_IITAGX then isilace:=true
                 else begin
                   ilace:=true;
                   if cv.version<TR_GUI9440 then wordadr:=wordadr div 2;
                 end;
               if (cv.mm=512) and (memmode>=_p8) and
                 (cv.version<TR_IITAGX) then hfreqfact:=2;
               if (rgs.grcregs.x[$F] and 8)>0 then pixwid:=pixwid*2;
               if (rgs.crtcregs.x[$29] and $10)>0 then inc(wid,256);
         end;
     __Tseng:if cv.version=ET_3000 then
             begin
           if (rgs.crtcregs.x[$25] and $80)>0 then ilace:=true;
               if (rgs.crtcregs.x[$25] and 1)>0 then inc(calcvblks,1024);
               if (rgs.crtcregs.x[$25] and 2)>0 then inc(calcvtot,1024);
               if (rgs.crtcregs.x[$25] and 4)>0 then inc(calclines,1024);
               if (rgs.crtcregs.x[$25] and 8)>0 then inc(calcvrtrs,1024);
           if (rgs.grcregs.x[5] and $40)>0 then wordadr:=16;
           if (rgs.seqregs.x[7] and $40)>0 then
           begin
         pixwid:=pixwid*2;
         wordadr:=wordadr*2;
           end;
         end
             else begin
               if (rgs.crtcregs.x[$3F] and $80)>0 then inc(wid,256);
               if (rgs.crtcregs.x[$3F] and  1)>0 then inc(calchtot,256);
               if (rgs.crtcregs.x[$3F] and  4)>0 then inc(calchblks,256);
               if (rgs.crtcregs.x[$3F] and 16)>0 then inc(calchrtrs,256);
               if (rgs.crtcregs.x[$35] and 1)>0 then inc(calcvblks,1024);
               if (rgs.crtcregs.x[$35] and 2)>0 then inc(calcvtot,1024);
               if (rgs.crtcregs.x[$35] and 4)>0 then inc(calclines,1024);
               if (rgs.crtcregs.x[$35] and 8)>0 then inc(calcvrtrs,1024);
               if (rgs.crtcregs.x[$35] and $80)>0 then isilace:=true;
               if (rgs.attregs[$10] and $40)>0 then pixwid:=4;
           {    if ((rgs.attregs[$16] and $20)>0) and (cv.version>=ET_4W32P) then pixwid:=pixwid*2; }
             end;
       __UMC:begin
           if (rgs.crtcregs.x[$33] and $10)>0 then wordadr:=16
               else if ((rgs.attregs[$10] and 64)>0) then
               begin
                 pixwid:=4;
                 hfreqfact:=2;
               end;
           if (rgs.crtcregs.x[$2F] and 1)>0 then
           begin
         ilace:=true;
         wordadr:=wordadr div 2;
                 dec(calclines);
           end;
         end;
    __video7:begin
           if (rgs.seqregs.x[$E0] and 1)<>0 then ilace:=true;
               if (rgs.attregs[$10] and $40)>0 then
               begin
                 pixwid:=4;
                 wordadr:=8;
                 hfreqfact:=2;
               end;
               if (rgs.seqregs.x[$C8] and $10)>0 then
               begin
                 force256:=true;
                 wordadr:=8;
               end;
         end;
    __Weitek:begin
               if (rgs.grcregs.x[$C] and 4)>0 then
               begin
                 wordadr:=8;
                 force256:=true;
               end;
             end;
 __xbe,__xga:begin
           calchtot  :=rgs.xxregs.x[$11]*256+rgs.xxregs.x[$10]+1;
           calcpixels:=rgs.xxregs.x[$13]*256+rgs.xxregs.x[$12]+1;
           calchblks :=rgs.xxregs.x[$15]*256+rgs.xxregs.x[$14]+1;
           calchblke :=rgs.xxregs.x[$17]*256+rgs.xxregs.x[$16]+1;
           calchrtrs :=rgs.xxregs.x[$19]*256+rgs.xxregs.x[$18]+1;
           calchrtre :=rgs.xxregs.x[$1B]*256+rgs.xxregs.x[$1A]+1;
           pixwid:=8;
           calclines :=rgs.xxregs.x[$23]*256+rgs.xxregs.x[$22]+1;
           calcvtot  :=rgs.xxregs.x[$21]*256+rgs.xxregs.x[$20]+1;
           calcvblks :=rgs.xxregs.x[$25]*256+rgs.xxregs.x[$24]+1;
           calcvblke :=rgs.xxregs.x[$27]*256+rgs.xxregs.x[$26]+1;
           calcvrtrs :=rgs.xxregs.x[$29]*256+rgs.xxregs.x[$28]+1;
           calcvrtre :=rgs.xxregs.x[$2B]*256+rgs.xxregs.x[$2A]+1;  {Hm!!}
           wid :=rgs.xxregs.x[$44]*256+rgs.xxregs.x[$43];
           wordadr:=8;
               case rgs.xxregs.x[$51] and 7 of
                 2:calcmmode:=_pk4;
                 3:calcmmode:=_p8;
                 4:calcmmode:=_p16;  {or _p15}
                 5:calcmmode:=_p24;
               end;
               if (rgs.xxregs.x[$50] and 8)>0 then isilace:=true;
         end;
    end;

    if (cv.flags and FLG_StdVGA)>0 then
    begin
      calchblke:=(calchblks and (not hblkmask))+calchblke;
      if calchblke<=calchblks then inc(calchblke,hblkmask+1);
      if calchblke>calchtot then calchblke:=calchtot+(hblkmask and calchblke);
      calchrtre:=(calchrtrs and (not hrtrmask))+calchrtre;
      if calchrtre<=calchrtrs then inc(calchrtre,hrtrmask+1);
      if calchrtre>calchtot then calchrtre:=calchtot+(hrtrmask and calchrtre);
      calcvblke:=(calcvblks and (not vblkmask))+calcvblke;
      if calcvblke<=calcvblks then inc(calcvblke,vblkmask+1);
      calcvrtre:=(calcvrtrs and (not vrtrmask))+calcvrtre;
      if calcvrtre<=calcvrtrs then inc(calcvrtre,vrtrmask+1);

      if (rgs.crtcregs.x[$17] and 4)>0 then
      begin
        calclines:=calclines*2;
        calcvtot:=calcvtot*2;
      end;
      if ilace then calclines:=calclines*2;
      if isilace then ilace:=true;
      if (rgs.attregs[$10] and 1)=0 then  {Text}
      begin
        calclines:=calclines div ((rgs.crtcregs.x[9] and $1F)+1);
        if (rgs.attregs[$10] and 2)=0 then calcmmode:=_TEXT
                      else calcmmode:=_TXT4;
        pixwid:=charwid;
      end
      else begin
        if ((rgs.crtcregs.x[$17] and 1)=0)
          and ((rgs.attregs[$10] and 64)=0) then {CGA}
        begin
      if (rgs.crtcregs.x[$17] and $40)>0 then calcmmode:=_cga1
                         else calcmmode:=_cga2;
      extlinfact:=extlinfact shr 1;
        end
        else if ((rgs.attregs[$10] and 64)=0) and ((rgs.grcregs.x[5] and 64)=0)
          and not force256 then  {16 color}
        begin
      if ((rgs.attregs[$10] and 2)>0) then calcmmode:=_pl1
      else if (rgs.attregs[$12]=5) then
      begin
        calcmmode:=_pl2;
        pixwid:=pixwid*2;
      end
      else if (rgs.seqregs.x[4] and 8)>0 then calcmmode:=_pk4
                         else calcmmode:=_pl4;
        end
        else calcmmode:=_p8;
      end;
    end;


    if (calcmmode>=_PK4) and (cv.dactype>_dac8) then
    begin
      x:=rgs.dacregs[6]{getdaccomm};

      case cv.dactype of
   _dac15:if x>127 then calcmmode:=_p15;
   _dac16:case (x and $c0) of
           $80:calcmmode:=_p15;
           $c0:calcmmode:=_p16;
          end;
 _dacALG1101:
          if (cv.chip=__ALG) and ((rgs.crtcregs.x[$19] and 16)>0) then
            calcmmode:=_p16;     {Only used on ALG chips ??}
 _dacMU1880:
          begin
            outp($3C8,0);
            for m:=1 to 4 do x:=inp($3C6);
              while x<>$8e do x:=inp($3C6);
              x:=inp($3C6);
              rgs.stdregs[$3c1]:=x;
              case x of
                $A6:calcmmode:=_p16;
                $A0:calcmmode:=_p15;
                $9E:calcmmode:=_p24b;
              end;
          end;
 _dacICS5301,_dacMU4910,_dacMU9910,_dacATT490,_dacATT491,_dacATT492,
 _dacATT493,_dacCH8391:
          case (x and $E0) of
         $80,$A0:calcmmode:=_p15;
             $C0:calcmmode:=_p16;
             $E0:calcmmode:=_p24;
          end;
 _dacATT498,_dacATT1498,_dacATT2498:
          case x shr 4 of
            1:begin
                calcmmode:=_p15;
                pixwid:=pixwid*2;
                vclkdiv:=vclkdiv div 2;
              end;
            2:begin
                pixwid:=pixwid*2;
                vclkdiv:=vclkdiv div 2;
              end;
            3:begin
                calcmmode:=_p16;
                pixwid:=pixwid*2;
                vclkdiv:=vclkdiv div 2;
              end;
            5:begin
                calcmmode:=_p32;
                pixwid:=pixwid*2;
                vclkdiv:=vclkdiv div 2;
              end;
            6:calcmmode:=_p16;
           10:calcmmode:=_p15;
          end;
 _dacALG1201,_dacALG1301:
          case (x and $E0) of
            $A0:calcmmode:=_p15;
            $C0:calcmmode:=_p16;
            $E0:calcmmode:=_p24;
          end;
 _dacADAC1:
          case (x and $C7) of
            $C1:calcmmode:=_p16;
            $C5:calcmmode:=_p24;
            $80:calcmmode:=_p15;
          end;
 _dacSC15021,_dacSC15025:
          begin
            case (x and $E1) of
              $41:calcmmode:=_p32b;
              $40:calcmmode:=_p32;
              $61:calcmmode:=_p24b;
              $60:calcmmode:=_p24;
  $80,$81,$A0,$A1:calcmmode:=_p15;
          $C0,$E0:calcmmode:=_p16;
            end;
            if rgs.dacinxd.x[$10]>0 then
            begin
              pixwid:=pixwid*2;
              vclkdiv:=vclkdiv div 2;
            end;
          end;
_dacTR8001:case x and $E0 of
             $A0:calcmmode:=_p15;
             $E0:calcmmode:=_p16;
             $C0:calcmmode:=_p24;
           end;
_dacUMC188:case (x and $D0) of
             $80:calcmmode:=_p15;
             $C0:calcmmode:=_p16;
 $10,$50,$90,$D0:calcmmode:=_p24;
           end;
  _dacSTG1700,_dacSTG1702,_dacSTG1703:
           if (x and 8)>0 then
             case rgs.dacinxd.x[3] of
               1:begin
                   calcmmode:=_P15;
                   pixwid:=pixwid*2;
                 end;
               2:begin
                   calcmmode:=_p15;
                   pixwid:=pixwid*2;
                   vclkdiv:=vclkdiv div 2;
                 end;
               3:begin
                   calcmmode:=_p16;
                   pixwid:=pixwid*2;
                   vclkdiv:=vclkdiv div 2;
                 end;
               4:begin
                   calcmmode:=_P32;
                   pixwid:=pixwid*2;
                   vclkdiv:=vclkdiv div 2;
                 end;
               5:begin  {P8 - two pixels/clock}
                   calcmmode:=_P8;
                   vclkdiv:=vclkdiv div 2;
                 end;
               6:begin
                   calcmmode:=_P16;
                   pixwid:=pixwid*2;
                 end;
               9:begin
                   calcmmode:=_p24;
                   pixwid:=pixwid*2;
                   vclkdiv:=vclkdiv div 2;
                 end;
             end
             else
               case x and $E0 of
                 $A0:calcmmode:=_p15;
                 $C0:calcmmode:=_p16;
                 $E0:calcmmode:=_p24;
               end;
_dacCH8398:case rgs.dacregs[dacHIcmd] shr 4 of
             6:calcmmode:=_p16;
             3:begin
                 calcmmode:=_p16;
                 pixwid:=pixwid*2;
                 vclkdiv:=vclkdiv div 2;
               end;
             7:calcmmode:=_p24;  {24bpp = 2pixels/3VCLKs}
            $B:begin  {24bpp = 2pixels/3VCLKs}
                 calcmmode:=_p24;
                 pixwid:=pixwid*2;
                 vclkdiv:=vclkdiv div 2;
               end;
            $C:calcmmode:=_p15;
             1:begin  {15bit 1VCLK/pixel}
                 calcmmode:=_p15;
                 pixwid:=pixwid*2;
                 vclkdiv:=vclkdiv div 2;
               end;
           end;
 _dacS3_708,_dacS3_716:
           case rgs.dacregs[dacHIcmd] and $F0 of
               (*  $10:begin  {2 8bpp pixels/VCLK}
                       vclkdiv:=vclkdiv div 2;
                     end; *)
             $20:calcmmode:=_p15;
             $30:begin
                   calcmmode:=_p15;
                   vclkdiv:=vclkdiv div 2;
                 end;
             $50:begin
                   calcmmode:=_p16;
                   vclkdiv:=vclkdiv div 2;
                 end;
             $60:calcmmode:=_p16;
             $70:begin  {32bpp = 2 VCLKs}
                   calcmmode:=_p32;
                   vclkdiv:=vclkdiv div 2;
                 end;
             $E0:calcmmode:=_p24;
           end;
 _dacBt481,_dacBt482:
           case rgs.dacregs[6] and $F0 of
             $A0:calcmmode:=_P15;
             $E0:calcmmode:=_P16;
             $F0:calcmmode:=_P24;
           end;
 _dacBt484,_dacBt485,_dacATT504,_dacATT505:
           if (rgs.dacregs[9] and $20)>0 then
           begin
             case rgs.dacregs[8] and $78 of
               $10:calcmmode:=_p32;
               $30:calcmmode:=_p15;
               $38:calcmmode:=_p16;
               $60:calcmmode:=_pk4;
             end;
             pixwid:=pixwid*4;
             if (cv.dactype=_dacBt485) or (cv.dactype=_dacATT505) then
               if (rgs.dacregs[16] and 8)>0 then vclkdiv:=vclkdiv div 2; {clk*2}
           end;
 _dacTVP3010,_dacTVP3020,_dacTVP3025,_dacTVP3026:
           begin
             case rgs.dacinxd.x[$18] and $CF of
               $C:calcmmode:=_P15;
               $D:calcmmode:=_P16;
             6,$E:calcmmode:=_P32;
             end;
             if (rgs.dacinxd.x[$1A] and $10)>0 then
             begin
               vclkdiv:=vclkdiv div 2;
               pixwid:=pixwid*2;
             end;
             SerialDAC:=false;
           end;
 _dacTLC34075:
           begin    {TLC34075}
             if (rgs.dacregs[9]=1) then {On the ATI Mach32 the VCLK is
                                         looped back to CLK1, really should
                                         test explicitly for such loops }
               case (rgs.dacregs[10] shr 3) and 7 of
                 1:vclkdiv:=vclkdiv*2;
                 2:vclkdiv:=vclkdiv*4;
                 3:vclkdiv:=vclkdiv*8;
                 4:vclkdiv:=vclkdiv*16;
                 5:vclkdiv:=vclkdiv*32;
               end;
             SerialDAC:=false;
           end;
   _dacInt:case cv.chip of
             __chips:case rdinx(cv.IOadr,6) and $C of
                       0:if (cv.Version=CT_64300) and
                           ((rgs.xxregs.x[$28] and $10)=0) then calcmmode:=_pk4;
                       4:calcmmode:=_p15;
                       8:calcmmode:=_p24;
                      $C:calcmmode:=_p16;
                     end;
             __cir54:begin
                       case x and $CF of
                     $80,$C0:calcmmode:=_p15;
                         $C1:calcmmode:=_p16;
                         $C5:if (cv.Version>=CL_GD5430) and
                               ((rgs.seqregs.x[7] and 8)>0) then calcmmode:=_p32
                             else calcmmode:=_p24;
                         $C8:;  {8bit Grey scale}
                         $C9:;  {3-3-2 RGB}
                       end;
                       SerialDAC:=false;
                     end;
                __WD:case rdinx(SEQ,$26) and $C of
                       4:calcmmode:=_P16;
                     {  8:calcmmode:=_p16b;  }
                      $C:calcmmode:=_P15;
                     end;
                __S3:case rgs.crtcregs.x[$67] shr 4 of
                      { 1:vclkdiv:=vclkdiv div 2;  {2px/VCLK}
                       3:begin
                           calcmmode:=_P15;
                           vclkdiv:=vclkdiv div 2;  {1px/VCLK}
                         end;
                       5:begin
                           calcmmode:=_P16;
                           vclkdiv:=vclkdiv div 2;  {1px/VCLK}
                         end;
                       7:begin
                           calcmmode:=_P32;
                           vclkdiv:=vclkdiv div 2;  {1px/2VCLK}
                         end;
                      13:begin
                           calcmmode:=_P32;    {1px/VCLK}
                           SerialDAC:=false;
                         end;
                     end;
               __SiS:begin
                       case rgs.seqregs.x[6] and $1C of
                          4:calcmmode:=_P15;
                          8:calcmmode:=_P16;
                         16:calcmmode:=_P24;
                       end;
                       SerialDAC:=false;
                     end;
              __Trid:if cv.version<TR_GUI9440 then
                       case rgs.dacregs[6] shr 5 of
                         5:calcmmode:=_p15;
                         7:calcmmode:=_p16;
                         6:calcmmode:=_p24;
                       end
                     else begin
                       case rgs.dacregs[6] shr 4 of
                         1:calcmmode:=_p15;
                         3:calcmmode:=_p16;
                        13:begin
                             calcmmode:=_p24;
                             SerialDAC:=false;
                             vclkdiv:=vclkdiv*3;
                           end;
                       end;
                     end;
           end;
      end;
      if SerialDAC then
    case calcmmode of               {Adjust for HiColor}
      _p15,_p16:begin
                  pixwid:=pixwid div 2;
                  vclkdiv:=vclkdiv*2;
                end;
     _P24,_P24b:begin
                  calcpixels:=calcpixels div 3;
                  calchtot:=calchtot div 3;
                  calchblks:=calchblks div 3;
                  calchblke:=calchblke div 3;
                  calchrtrs:=calchrtrs div 3;
                  calchrtre:=calchrtre div 3;
                  vclkdiv:=vclkdiv*3;
                end;
           _p32:begin
                  pixwid:=pixwid div 4;
                  vclkdiv:=vclkdiv*4;
                end;
    end;
    end;
  end;
  if calcmmode>=_herc then calcpixels:=calcpixels*pixwid;
  calcbytes:=wid*wordadr;

  vclk:=GetClockFreq;


  calchtot :=calchtot*pixwid;
  calchblks:=calchblks*pixwid;
  calchblke:=calchblke*pixwid;
  calchrtrs:=calchrtrs*pixwid;
  calchrtre:=calchrtre*pixwid;
  vclk:=(vclk*12) div vclkdiv;
  if vclk>0 then
  begin
    hclk:=(vclk*1000) div (calchtot*hfreqfact);
    fclk:=(hclk*1000) div calcvtot;
  end;
  if extlinfact>0 then calclines:=calclines div extlinfact;
  BWlow :=hclk;
  case memmode of
 _PL4,_PK4,_PK4a:BWlow:=BWlow div 2;
       _P15,_P16:BWlow:=BWlow*2;
      _P24,_P24b:BWlow:=BWlow*3;
     _P32.._P32d:BWlow:=BWlow*4;
  end;

  BWhigh:=(BWlow*calchtot) div 1000;
  BWlow :=(BWlow*calcpixels) div 1000;

  if memmode<=_TXT4 then
  begin
    BWlow :=BWlow*3;
    BWhigh:=(BWhigh*3) div 8;
  end;

  if VESAcheat then cv.chip:=__VESA;
  rgs.bytes :=calcbytes;
  rgs.pixels:=calcpixels;
  rgs.lins  :=calclines;
  rgs.mmode :=calcmmode;
  rgs.chip  :=cv.chip;
end;


procedure AnalyseMode;
begin
  DumpRegisters;
  CalcRegisters;
end;

procedure wrregs(var rg:regblk);
var x:word;
begin
  write(hex4(rg.base)+':');
  for x:=0 to rg.nbr do
  begin
    if (x mod 25=0) and (x>0) then
      write('('+hex2(x)+'):');

    write(' '+hex2(rg.x[x]));
  end;
  writeln;
end;

function dumpVGAregs:word;
var x,y:word;
begin
  settextmode;  {Set 43/50 line text mode}
  writeln('Mode: '+hex2(rgs.mode)+'h Pixels: '+istr(rgs.pixels)+' lines: '+istr(rgs.lins)
       +' bytes: '+istr(rgs.bytes)+' colors: '+istr(modecols[rgs.mmode]));
  writeln;
  if oldreg then writeln('SEQ (OLD): 0Dh: ',hex2(rgs.tridold0d)
                  ,' 0Eh: ',hex2(rgs.tridold0e));

  for x:=$3C0 to $3CF do write(' '+hex2(rgs.stdregs[x]));
  writeln;
  for x:=$3D0 to $3DF do write(' '+hex2(rgs.stdregs[x]));
  writeln;
  write('03C0:');
  for x:=0 to 31 do
  begin
    if x=25 then write('(19):');
    write(' '+hex2(rgs.attregs[x]));
  end;
  writeln;
  wrregs(rgs.seqregs);
  wrregs(rgs.grcregs);
  wrregs(rgs.crtcregs);
  if rgs.xxregs.base<>0 then
  begin
    if (rgs.xxregs.base and $ff8f)=$210A then
    begin
      write(hex4(rgs.xxregs.base and $fff0)+':');
      for x:=0 to 15 do write(' '+hex2(rgs.xgaregs[x]));
      writeln;
    end;
    wrregs(rgs.xxregs);
  end;
  writeln;
  write('DAC: ');
  for x:=0 to 16 do
    write(' '+hex2(rgs.dacregs[x]));
  writeln;
  if rgs.dacinxd.base<>0 then wrregs(rgs.dacinxd);
  dumpVGAregs:=getkey;
end;

function FormatRgs(var b:byte):word;   {Format registers for dump}
type
  barr=array[1..2000] of byte;
var
  blk:^barr;
  bts,x:word;

procedure appb(b:byte);
begin
  inc(bts);
  blk^[bts]:=b;
end;

procedure appw(w:word);
begin
  appb(lo(w));
  appb(hi(w));
end;

procedure apprgs(var r:regblk);
var x:word;
begin
  appw(1);
  appw(r.base);
  appb(0);
  appb(r.nbr);
  for x:=0 to r.nbr do appb(r.x[x]);
end;

begin
  blk:=@b;
  bts:=0;
  appw(1);
  appw($3C0);
  appb(0);
  appb(31);
  for x:=0 to 31 do appb(rgs.attregs[x]);
  apprgs(rgs.seqregs);
  apprgs(rgs.grcregs);
  apprgs(rgs.crtcregs);
  if rgs.xxregs.base<>0 then apprgs(rgs.xxregs);
  if oldreg then
  begin
    appw($FF);
    appw(0);
    appb(rgs.tridold0d);
    appw($FF);
    appw(1);
    appb(rgs.tridold0e);
  end;
  for x:=0 to 16 do {DAC registers 0-10h}
  begin
    appw($FF);
    appw($F000+x);
    appb(rgs.dacregs[x]);
  end;
  if rgs.dacinxd.nbr>0 then apprgs(rgs.dacinxd);
  if (rgs.xxregs.base and $FF8F)=$210A then
  begin
    appw(16);
    appw(rgs.xxregs.base-$A);
    for x:=0 to 15 do appb(rgs.xgaregs[x]);
  end;
  appw($3C2);
  appb(rgs.stdregs[$3C2]);
  appw(4);
  appw($3CA);
  for x:=$3CA to $3CD do appb(rgs.stdregs[x]);
  appw(8);
  appw(crtc+4);
  for x:=$3D8 to $3DF do appb(rgs.stdregs[x]);
  appw(0);
  FormatRgs:=bts;
end;


procedure dumpVGAregfile;
var
  f:file of regtype;
begin
  assign(f,'register.vga');
  {$i-}
  reset(f);
  {$i+}
  if ioresult=0 then seek(f,filesize(f)) else rewrite(f);
  write(f,rgs);
  close(f);
end;





function tstrg(pt,msk:word):boolean;       {Returns true if the bits in MSK
                                            of register PT are read/writable}
var old,nw1,nw2:word;
begin
  old:=inp(pt);
  outp(pt,old and not msk);
  nw1:=inp(pt) and msk;
  outp(pt,old or msk);
  nw2:=inp(pt) and msk;
  outp(pt,old);
  tstrg:=(nw1=0) and (nw2=msk);
end;

function testinx2(pt,rg,msk:word):boolean;   {Returns true if the bits in MSK
                                              of register PT index RG are
                                              read/writable}
var old,nw1,nw2:word;
begin
  old:=rdinx(pt,rg);
  wrinx(pt,rg,old and not msk);
  nw1:=rdinx(pt,rg) and msk;
  wrinx(pt,rg,old or msk);
  nw2:=rdinx(pt,rg) and msk;
  wrinx(pt,rg,old);
  testinx2:=(nw1=0) and (nw2=msk);
end;

function testinx(pt,rg:word):boolean;     {Returns true if all bits of
                                           register PT index RG are
                                           read/writable.}
var old,nw1,nw2:word;
begin
  testinx:=testinx2(pt,rg,$ff);
end;

procedure UNK(vers,code:word);
begin
  cv.version:=vers;
  cv.subvers:=code;
end;

procedure SetVersion(vers:word;nam:string);
begin
  cv.Version:=vers;
  cv.name:=nam;
end;


procedure SetDAC(typ:word;Name:string);
begin
  cv.dactype:=typ;
  cv.dacname:=name;
end;


procedure addvideo;
var nam,s:string;
    x,nr,err:word;
    ok:boolean;
begin
  nam:='';
  if force_version<>0 then cv.version:=force_version;
  if cv.version<>0 then
  begin
    for x:=1 to NBRCHIPS do
    begin
      if cv.version=CHIPSLIST[x].nbr then
      begin
        nam:=CHIPSLIST[x].nam;
        if nam[length(nam)]='(' then nam:=nam+hex4(cv.subvers)+')';
      end;
    end;
  end;
  if cv.Version=ET_4000 then
    case cv.Subvers of
      TS_SpeedStar:nam:=nam+' (SpeedStar)';
      TS_Genoa7900:nam:=nam+' (Genoa7900)';
    end;
  cv.flags:=cv.flags or FLG_ExtDAC;    {Allow Ext DAC addressing}
  if (cv.flags and FLG_StdVGA)>0 then ok:=setmode($12,false);  {Set std mode}
  if cv.dactype=_dac0 then testdac;
  if (cv.chip=__ALG) and (cv.dactype=_dac8) then SetDAC(_dacALG1101,'ALG1101');

  if (DACflags and DFL_CmdReg)>0 then   {Must have CMD register}
  begin
    x:=inp(SetDACpage(dacHIcmd));      {test if RS2/3 works}
    clearDACpage;
    if x<>getdaccomm then cv.flags:=cv.flags and (not FLG_ExtDAC);
  end;

  if cv.dactype=_dacInt then cv.dacname:='Internal';
  if force_mm<>0 then cv.mm:=force_mm;
  fillchar(cv.clks,sizeof(cv.clks),0);
  if (cv.chip<>__vesa) and clocktest then findclocks;
  inc(vids);
  vid[vids]:=cv;
  vid[vids].name :=nam+' '+cv.name;
  vid[vids].sname:=chipnam[cv.chip];
  SetTextMode;    {Reset any special bits}
end;





   (*  Tests for various adapters  *)


procedure _Acer;
var old:word;
begin
  old:=rdinx(GRC,$FF);
  clrinx(GRC,$FF,7);
  if not testinx2(GRC,$10,$9F) then
  begin
    clrinx(GRC,$FF,7);
    if testinx2(GRC,$10,$9F) then
    begin
      cv.chip:=__Acer;
      case rdinx(GRC,$E) and $C of
        0:cv.mm:=256;
        1:cv.mm:=512;
        2:cv.mm:=1024;
        3:cv.mm:=2048;
      end;
      addvideo;
    end;
  end;
  wrinx(GRC,$FF,old);
end;

procedure _ahead;
var old:word;
begin
  old:=rdinx(GRC,$F);
  wrinx(GRC,$F,0);
  if not testinx2(GRC,$C,$FB) then
  begin
    wrinx(GRC,$F,$20);
    if testinx2(GRC,$C,$FB) then
    begin
      cv.chip:=__ahead;
      case rdinx(GRC,$F) and 15 of
    0:cv.Version:=AH_A;
    1:begin
        cv.Version:=AH_B;
        cv.features:=ft_rwbank;
            cv.clktype:=clk_ext4;
      end;
      end;
      case rdinx(GRC,$1F) and 3 of
    0:cv.mm:=256;
    1:cv.mm:=512;
    2:;
    3:cv.mm:=1024;
      end;
      addvideo;
    end;
  end;
  wrinx(GRC,$F,old);
end;

procedure _ALG;
var old:integer;
begin
  old:=rdinx(crtc,$1A);
  clrinx(crtc,$1A,$10);
  if not testinx2(crtc,$19,$CF) then
  begin
    setinx(crtc,$1A,$10);
    if testinx2(crtc,$19,$CF) and testinx2(crtc,$1A,$3F) then
    begin
      cv.chip:=__ALG;
      cv.subvers:=rdinx(crtc,$1A);
      case cv.subvers shr 6 of
        3:begin
            cv.Version:=ALG_2101;
            {SetDAC(_dacalg,'ALG1101');}
           end;
        2:if (rdinx(crtc,$1B) and 4)>0 then cv.Version:=ALG_2228
                                       else cv.Version:=ALG_2301;
           {The 2228/2301/230x should probably be ID'd from the PCI ID ?}
        1:cv.version:=ALG_2201;
      else cv.Version:=ALG_Unknown;
      end;
      cv.clktype:=clk_ext4;
      cv.features:=ft_rwbank+ft_blit+ft_cursor+ft_line;
      if cv.version>ALG_2101 then cv.features:=ft_rwbank;  {CBL don't work yet!}
      case rdinx(crtc,$1E) and 3 of
    0:cv.mm:=256;
    1:cv.mm:=512;
    2:cv.mm:=1024;
    3:cv.mm:=2048;
      end;
      addvideo;
    end;
  end;
  wrinx(crtc,$1A,old);
end;

procedure _Alliance;
begin
  if (rdinx(SEQ,$11)=$41) and (rdinx(SEQ,$12)=$53) then
  begin
    cv.chip:=__Alli;
    cv.version:=ALi_3210;

    if mem[SegA000:$D8]=0 then;
    outpw(SEQ,$1210);
    setinx(SEQ,$1C,8);
    modinx(SEQ,$1B,7,1);
    cv.mm:=mem[SegA000:$F0]*64;   {Video Memory}
    clrinx(SEQ,$1B,7);
    clrinx(SEQ,$1C,8);
    addvideo;
  end;
end;

procedure _ARK;
var old:word;
begin
  old:=rdinx(SEQ,$1D);
  wrinx(SEQ,$1D,0);    {Lock the ext registers}
  if not (testinx(SEQ,$11) and testinx(SEQ,$12)) then
  begin
    wrinx(SEQ,$1D,old);
    if testinx(SEQ,$11) and testinx(SEQ,$12) then
    begin
      cv.chip:=__ARK;
      cv.SubVers:=rdinx(crtc,$50);
      case cv.SubVers and $F8 of
        $88:cv.Version:=ARK_1000VL;
        $90:cv.Version:=ARK_1000PV;
        $98:cv.Version:=ARK_2000PV;
      else cv.version:=ARK_Unknown;
      end;
      cv.clktype:=clk_ext4;
      cv.features:=ft_rwbank+ft_cursor;
      if cv.Version=ARK_2000PV then
        case rdinx(SEQ,$10) shr 6 of
          0:cv.mm:=1024;
          1:cv.mm:=2048;
          2:cv.mm:=4096;
          3:cv.mm:=8192;
        end
      else
        if (rdinx(SEQ,$10) and $40)>0 then cv.mm:=2048
                                      else cv.mm:=1024;
      addvideo;
    end;
  end;
  wrinx(SEQ,$1D,old);
end;


procedure _ati;
var w,mall,mvga:word;
  l:longint;
begin
  if getbios($31,9)='761295520' then
  begin
    case memw[biosseg:$40] of
     $3133:begin
         cv.IOadr:={memw[biosseg:$10]}$1CE;
         w:=rdinx(cv.IOadr,$BB);
         case w and 15 of
           0:_crt:='EGA';
           1:_crt:='Analog Monochrome';
           2:_crt:='Monochrome';
           3:_crt:='Analog Color';
           4:_crt:='CGA';
           6:_crt:='';
           7:_crt:='IBM 8514/A';
         else _crt:='Multisync';
         end;
         cv.chip:=__ati;
         cv.SubVers:=mem[biosseg:$43];
         case cv.SubVers of
          $31:cv.Version:=ATI_18800;
          $32:cv.Version:=ATI_18800_1;
          $33:cv.Version:=ATI_28800_2;
          $34:cv.Version:=ATI_28800_4;
          $35,$36:if (rdinx(cv.IOadr,$AA) and 15)=6 then
                       cv.Version:=ATI_28800_6
                  else cv.Version:=ATI_28800_5;
              $20:begin
            cv.SubVers:=inpw($6EEC);
                    case cv.Subvers of
                      $57:cv.Version:=ATI_M64_CX;
                      $D7:cv.Version:=ATI_M64_GX;
                    else  cv.Version:=ATI_M64_Unk;
                    end;
                    cv.Xseg:=$BFC0;  {Memory mapped regs at BFC00h}
                    if (inpw($72EC) and $E00)=$A00 then
                      SetDAC(_dacATI68860,'ATI 68860');  {Hack!}
                  end;
         $61..$63:begin  {Mach32}
            cv.SubVers:=inpw($FAEE);
            case cv.SubVers and $3FF of
             $2F7:cv.Version:=ATI_GUP_6;
             $177:cv.Version:=ATI_GUP_LX;
             $017:cv.Version:=ATI_GUP_AX;
            0:cv.Version:=ATI_GUP_3;
                    else  cv.Version:=ATI_M32_Unk;
            end;
          end;
         else cv.Version:=ATI_Unknown;
         end;
             if cv.Version=ATI_18800 then cv.clktype:=clk_ext3
                                     else cv.clktype:=clk_ext4;
         if cv.Version>=ATI_18800_1 then cv.features:=ft_rwbank;
         case cv.Version of
       ATI_18800,ATI_18800_1:
               if (rdinx(cv.IOadr,$BB) and $20)<>0 then cv.mm:=512;
       ATI_28800_2:if (rdinx(cv.IOadr,$B0) and $10)<>0 then cv.mm:=512;
       ATI_28800_4,ATI_28800_5,ATI_28800_6:
               case rdinx(cv.IOadr,$B0) and $18 of
               0:cv.mm:=256;
             $10:cv.mm:=512;
               8,$18:cv.mm:=1024;
               end;
       ATI_GUP_3..ATI_GUP_LX:
                       begin
                 case inp($36EE) and $C of
               0:mall:=512;
               4:mall:=1024;
               8:mall:=2048;
              12:mall:=4096;
                 end;
                         mvga:=mall;
                         if (inp($42EE) and $10)>0 then   {Split VGA/Mach mem}
                         begin
                           mvga:=(inp($42EE) and $F)*256;
                           if mvga>mall then mvga:=mall;
                         end;
                         cv.mm:=mvga;
                       end;
            ATI_M64_GX:begin
                         l:=inpl($52EC);
                         case l and 7 of
                           0:mall:=512;
                           1:mall:=1024;
                           2:mall:=2048;
                           3:mall:=4096;
                           4:mall:=6144;
                           5:mall:=8192;
                         end;
                         mvga:=mall;
                         if (l and $40000)>0 then
                         begin
                           case (l shr 16) and 3 of
                             0:mvga:=0;
                             1:mvga:=256;
                             2:mvga:=512;
                             3:mvga:=1024;
                           end;
                           if mvga>mall then mvga:=mall;
                         end;
                         cv.mm:=mvga;
                         if cv.mm>1024 then cv.mm:=1024;
                       end;
         end;
       end;
     $3233:begin
         cv.Version:=ATI_EGA;
         video:='EGA';
         cv.chip:=__ega;
       end;
    end;
    addvideo;
    if cv.version>=ATI_GUP_3 then  {Now add the VGA part}
    begin
      if cv.Version>=ATI_M64_GX then cv.chip:=__Mach64
                                else cv.chip:=__Mach32;
      cv.flags:=cv.flags and (not FLG_StdVGA);
      cv.mm:=mall;
      if mvga<mall then cv.mm:=mall-mvga;
      cv.features:=cv.features or ft_cursor or ft_line or ft_blit;
                    if (inpw($72EC) and $E00)=$A00 then
                      SetDAC(_dacATI68860,'ATI 68860');  {Hack!}
      addvideo;
    end;
  end;
end;

procedure _chipstech;
var prt,old,x:word;
begin
  vio($5F00);
  if rp.al=$5F then
  begin
    cv.subvers:=rp.bl;
    case cv.SubVers shr 4 of
      0:cv.Version:=CT_451;
      1:cv.Version:=CT_452;
      2:cv.Version:=CT_455;
      3:cv.Version:=CT_453;
      4:cv.Version:=CT_450;
      5:cv.Version:=CT_456;
      6:cv.Version:=CT_457;
      7:cv.Version:=CT_65520;
      8:cv.Version:=CT_65530;
      9:cv.Version:=CT_65510;
     10:cv.Version:=CT_64200;
     11:if cv.subvers>=$B8 then cv.Version:=CT_64310
                           else cv.Version:=CT_64300;
     12:cv.Version:=CT_65535;
     13:if cv.subvers>=$D8 then cv.Version:=CT_65545
                           else cv.Version:=CT_65540;
    else cv.Version:=CT_Unknown;
    end;
    cv.clktype:=clk_ext3;
    if cv.version<CT_450 then
    begin
      prt:=$46E8;     {Should be $94 for MCA systems}
      outp(prt,$1E);    {Setup mode}

      x:=inp($103);
      outp($103,x or $80);  {Enable extensions}
      outp(prt,$E);
      if (x and $40)=0 then cv.IOadr:=$3D6 else cv.IOadr:=$3B6;
    end
    else begin
      cv.IOadr:=$3D6;
      if cv.version=CT_64300 then
      begin
        cv.clktype:=clk_internal;
        setDAC(_dacInt,'CT 24bit DAC');
      end
      else setDAC(_dacInt,'CT 15/16bit DAC');
    end;
    cv.SubVers:=rdinx(cv.IOadr,0);
    cv.chip:=__chips;
    if cv.version=CT_452 then cv.features:=ft_cursor;
    case rdinx(cv.IOadr,4) and 3 of
       1:cv.mm:=512;
     2,3:begin
           cv.mm:=1024;
           if (cv.Version>=CT_64300) and ((rdinx(cv.IOadr,$F) and 3)=3) then
             cv.mm:=2048
         end;
    end;
    addvideo;
  end;
end;

procedure _cirrus;
var old,old6:word;
begin
  old6:=rdinx(SEQ,6);
  old:=rdinx(crtc,$C);
  outp(crtc+1,0);
  cv.SubVers:=rdinx(crtc,$1F);
  wrinx(SEQ,6,lo(cv.Subvers shr 4) or lo(cv.Subvers shl 4));
                         {The SubVers value is rotated by 4}
  if inp(SEQ+1)=0 then
  begin
    outp($3c5,cv.SubVers);
    if inp($3c5)=1 then
    begin
      case cv.SubVers of
    $EC:cv.Version:=CL_GD5x0;
    $CA:cv.Version:=CL_GD6x0;
    $EA:cv.Version:=CL_V7_OEM;
      else cv.Version:=CL_old_unk;
      end;
      cv.chip:=__cirrus;
      cv.features:=ft_cursor;
      addvideo;
    end;
  end;
  wrinx(crtc,$C,old);
  wrinx(SEQ,6,old6);
end;


procedure _cirrus54;
var x,old:word;
begin
  old:=rdinx(SEQ,6);
  wrinx(SEQ,6,0);
  if (rdinx(SEQ,6)=$F) then
  begin
    wrinx(SEQ,6,$12);
    if (rdinx(SEQ,6)=$12) and testinx2(SEQ,$1E,$3F) {and testinx2(crtc,$1B,$ff)} then
    begin
      case rdinx(SEQ,$A) and $18 of      {Alternate method:}
    0:cv.mm:=256;                    { case rdinx(SEQ,$F) and $18}
    8:cv.mm:=512;                    {   $10: cv.mm:=1024; }
       16:cv.mm:=1024;                   {   $18: cv.mm:=2048;  May not work}
       24:cv.mm:=2048;                   { else cv.mm:=512}
      end;
      cv.SubVers:=rdinx(crtc,$27);
      if testinx(GRC,9) then
      begin
        cv.features:=ft_cursor;
    case cv.SubVers of
            $18:cv.Version:=CL_AVGA2;
            $88:cv.Version:=CL_GD5402;
            $89:cv.Version:=CL_GD5402r1;
            $8A:cv.Version:=CL_GD5420;
            $8B:cv.Version:=CL_GD5420r1;
       $8C..$8F:cv.Version:=CL_GD5422;
       $90..$93:cv.Version:=CL_GD5426;
       $94..$97:cv.Version:=CL_GD5424;
       $98..$9B:cv.Version:=CL_GD5428;
       $9C..$9F:cv.Version:=CL_GD5429;   {Might not get here ??}
       $A0..$A3:cv.Version:=CL_GD5430;
  {     $A4..$A7:cv.Version:=CL_GD543x;  Probably does not exist}
       $A8..$AB:cv.version:=CL_GD5434;
       $2C..$2F:cv.version:=CL_GD7542;   {Nordic}
       $30..$33:cv.version:=CL_GD7543;   {Viking}
       $34..$37:cv.version:=CL_GD7541;   {Nordic Lite}
    else cv.Version:=CL_Unk54;
    end;
    SetDAC(_dacInt,'Cirrus Internal');
        if cv.Version>=CL_GD5426 then
          cv.features:=ft_cursor+ft_blit;
        if cv.Version>=CL_GD7541 then
          case rdinx(SEQ,$A) and 15 of
            0:cv.mm:=256;
            1:cv.mm:=512;
            2:cv.mm:=1024;
            3:cv.mm:=2048;
            4:cv.mm:=4096;
          end;
        if cv.Version>=CL_GD5430 then
          case rdinx(SEQ,$15) and 15 of    {Alternate method:}
            0:cv.mm:=256;              { case rdinx(SEQ,$F) and $18}
            1:cv.mm:=512;              {   $10: cv.mm:=1024; }
            2:cv.mm:=1024;             {   $18: cv.mm:=2048; }
            3:cv.mm:=2048;             { else cv.mm:=512;    }
            4:cv.mm:=4096;             { end;                }
          end;                         { if (rdinx(SEQ,$F) and $80)>0 then }
      end                                                { cv.mm:=cv.mm*2; }
      else if testinx(SEQ,$19) then
      begin
    case cv.SubVers shr 6 of
      0:cv.Version:=CL_GD6205;
      1:cv.Version:=CL_GD6235;
      2:cv.Version:=CL_GD6215;
      3:cv.Version:=CL_GD6225;
    end;
        cv.mm:=512;
        cv.features:=0;
      end
      else begin
    cv.Version:=CL_AVGA2;
        cv.features:=ft_cursor;
    case rdinx(SEQ,$A) and 3 of
      0:cv.mm:=256;
      1:cv.mm:=512;
      2:cv.mm:=1024;
    end;
      end;
      cv.chip:=__cir54;
      cv.clktype:=clk_internal;
      addvideo;
    end;
  end
  else wrinx(SEQ,6,old);
end;

procedure _cirrus64;
var x,old:word;
begin
  old:=rdinx(GRC,$A);
  wrinx(GRC,$A,$CE);  {Lock}
  if (rdinx(GRC,$A)=0) then
  begin
    wrinx(GRC,$A,$EC);  {unlock}
    if (rdinx(GRC,$A)=1) then
    begin
      cv.SubVers:=rdinx(GRC,$AA);
      case cv.SubVers shr 4 of
    4:cv.Version:=CL_GD6440;
    5:cv.Version:=CL_GD6412;
    6:cv.Version:=CL_GD5410;
    7:if testinx2(GRC,$87,$90) then cv.Version:=CL_GD6420B
                                   else cv.Version:=CL_GD6420A;
    8:cv.Version:=CL_GD6410;
      else cv.Version:=CL_Unk64;
      end;
      case rdinx(GRC,$BB) shr 6 of
    0:cv.mm:=256;
    1:cv.mm:=512;
    2:cv.mm:=768;
    3:cv.mm:=1024;
      end;
      cv.chip:=__cir64;
      cv.clktype:=clk_internal;
      addvideo;
    end;
  end;
  wrinx(GRC,$A,old);
end;


procedure _compaq;
var old,x:word;
begin
  old:=rdinx(GRC,$F);
  wrinx(GRC,$F,0);
  if not testinx(GRC,$45) then
  begin
    wrinx(GRC,$F,5);
    if testinx(GRC,$45) then
    begin
      cv.chip:=__compaq;
      cv.features:=ft_blit;
      cv.SubVers:=rdinx(GRC,$C) shr 3;
      case cv.SubVers of
    3:cv.Version:=CPQ_IVGS;
    5:cv.Version:=CPQ_AVGA;
    6:cv.Version:=CPQ_QV1024;
       $E:if (rdinx(GRC,$56) and 4)<>0 then cv.Version:=CPQ_QV1280
                                       else cv.Version:=CPQ_QV1024;
      $10:cv.Version:=CPQ_AVPort;  {What is this ?}
      else cv.Version:=CPQ_Unknown;
      end;
      if (rdinx(GRC,$C) and $B8)=$30 then  {QVision}
      begin
    cv.features:=cv.features + ft_cursor;
    wrinx(GRC,$F,5);
    case rdinx(GRC,$54) of
      0:cv.mm:=1024;  {old QV1024 fix}
      2:cv.mm:=512;
      4:cv.mm:=1024;
      8:cv.mm:=2048;
    end;
        cv.clktype:=clk_ext4;
      end
      else begin
    rp.bx:=0;
    rp.cx:=0;
    vio($BF03);
    if (rp.ch and 64)=0 then cv.mm:=512;
        cv.clktype:=clk_ext3;
      end;
      addvideo;
    end
  end;
  wrinx(GRC,$F,old);
end;

procedure _everex;
var x:word;
begin
  rp.bx:=0;
  vio($7000);
  if rp.al=$70 then
  begin
    x:=rp.dx shr 4;
    if  (x<>$678) and (x<>$236)
    and (x<>$620) and (x<>$673) then     {Some Everex boards use Trident chips.}
    begin
      case rp.ch shr 6 of
    0:cv.mm:=256;
    1:cv.mm:=512;
    2:cv.mm:=1024;
    3:cv.mm:=2048;
      end;
      cv.name:='Everex Ev'+hx[x shr 8]+hx[(x shr 4) and 15]+hx[x and 15];
      cv.chip:=__everex;
      addvideo;
    end;
  end;
end;

procedure _genoa;
var ad:word;
begin
  ad:=memw[biosseg:$37];
  if (memw[biosseg:ad+2]=$6699) and (mem[biosseg:ad]=$77) then
  begin
    case mem[biosseg:ad+1] of
      0:cv.Version:=GE_6200;
    $11:begin
      cv.Version:=GE_6400;
      cv.mm:=512;
    end;
    $22:cv.Version:=GE_6100;
    $33:cv.Version:=GE_5100;  {Do we need to detect the Tseng versions ??}
    $55:begin
      cv.Version:=GE_5300;
      cv.mm:=512;
    end;
    end;
    cv.clktype:=clk_ext3;
    if mem[biosseg:ad+1]<$33 then cv.chip:=__genoa {else cv.chip:=__ET3000};
    addvideo;
  end
end;

procedure _hmc;
begin
(*  if testinx(SEQ,$E7) and testinx(SEQ,$EE) then *)

  if testinx2(SEQ,$E7,$7F) and testinx2(SEQ,$EE,$F1) then
  begin
    if (rdinx(SEQ,$E7) and $10)>0 then cv.mm:=512;
    cv.chip:=__HMC;
    cv.clktype:=clk_ext4;
    if testinx(SEQ,$E7) and testinx(SEQ,$EE) then cv.Version:=HMC_304
                                             else cv.Version:=HMC_314;
    addvideo;
  end;
end;

procedure _Imagine;
var inx:integer;
begin
  inx:=CheckPCI(0,$105D,$2309);
  if inx>0 then
  begin
    cv.IOadr:=PCIrec[inx].base5 and $FFFE;
    case inp(cv.IOadr+$18) and $C0 of
        0:cv.mm:=4096;
      $40:cv.mm:=8192;
      $80:cv.mm:=16384;
      $C0:cv.mm:=32768;
    end;
    cv.version:=IMG_128;
    cv.chip:=__IMAG;
    cv.name:='';
    addvideo;
  end;
end;


procedure _matrox;
const
  segm:array[1..7] of word=($AC00,$C800,$CC00,$D000,$D400,$D800,$DC00);

  procedure addMGA(sgm:word);
  var l:longint;
  begin
    cv.mm:=2048;       {Still have to figure out memory, 2048 for now}
    cv.Xseg:=sgm;
    cv.chip:=__MGA;
    cv.subvers:=memw[sgm:$1E48];
    case cv.subvers of
      $1700:cv.version:=MGA_Titan;
      $1702:cv.version:=MGA_Helena;
    else cv.Version:=MGA_Unknown;
    end;
    cv.flags:=cv.flags and (not FLG_StdVGA);
    addvideo;
  end;

var i,j,inx:word;
begin    {First check for the Matrox VGA}
  if testinx(crtc,$E1) and testinx($3DE,0) then
  begin
    cv.chip:=__Matrox;
    cv.version:=MGA_VGA;   {Hm}
    cv.mm:=1024;
    addvideo;
  end;

  cv.dactype:=_dac0;   {Force DAC test}
  j:=0;
  for i:=1 to 7 do  {Check for MGA-II (Ultima)}
    if memw[segm[i]:$1E4A]=$A268 then
      addMGA(segm[i]);
  if getbios($78,3)='_VB' then
    addMGA($AC00);

  inx:=0;
  repeat
    inx:=CheckPCI(inx,$102B,$FFFF);  {Look for any Matrox}
    if (inx>0) and ((PCIrec[inx].device=$518) or (PCIrec[inx].device=$D10)) then
    begin
      cv.PCIid:=inx;
      wPCIlong($10,$AC000);  {MAP Matrox regs at AC000h}
      addMGA($AC00);
      wPCIlong($10,PCIrec[inx].l[4]);  {remap}
    end;
  until inx=0;
end;

procedure _MediaVis;   {MediaVision}
const
  IObase:array[0..4] of word=($538,$E88,$F48,$60C,$148);
var
  i,j,w:integer;
begin
  j:=0;i:=0;
  while (i<5) do
    if inp(IObase[i])=$38 then i:=i+100  {found one, now stop}
                          else inc(i);
 (*  - While this will detect an uninitialised PG1024, it will also falsely
       claim that about every second VGA card is a PG!!
  if i<100 then
  begin
    i:=0;
    while (i<5) do
      if (inp(IObase[i])=$FF) and (inp(IObase[i]+1)=$FF) then
         i:=i+100  {found one, now stop}
      else inc(i);
  end; *)
  if i>=100 then  {Found a PG1024}
  begin
    cv.IOadr  :=IObase[i-100];
    cv.chip   :=__MV;
    cv.mm     :=2304; {2.25Mb = 9*256K}
    cv.version:=MV_PG1024;
    addvideo;
  end

(* The 1280 detection does not work yet!
  else begin {Now try for a 1280}

    if (inp($539) and $CF)=$0A then outp($539,0);
    if (inp($E89) and $CF)=$4A then outp($E89,0);
    if (inp($F49) and $CF)=$8A then outp($F49,0);
    if (inp($60D) and $CF)=$CA then outp($60D,0);
    for i:=0 to 3 do
    begin
      w:=IObase[i]+1;
      if inp(w)=$FF then
      begin
        outp(w,$8A);
        for j:=1 to 100 do;
        if inp(w)=$FF then
        begin
          for j:=1 to 100 do;
          outp(w,$54);
          for j:=1 to 100 do;
          if inp(w)=$FF then
          begin
            outp(w,1);
            if inp(w)=$0A then;

            i:=999;   {Stop the loop}
          end;
        end;
        outp(w,$FF);
      end;
    end;
  end; *)
end;

procedure _mxic;
var old:integer;
begin
  old:=rdinx(SEQ,$A7);
  wrinx(SEQ,$A7,0);       {disable extensions}
  if not testinx(SEQ,$C5) then
  begin
    wrinx(SEQ,$A7,$87);   {enable extensions}
    if testinx(SEQ,$C5) then
    begin
      cv.chip:=__mxic;
      cv.clktype:=clk_ext3;
      if (rdinx(SEQ,$26) and 1)=0 then cv.Version:=MX_86010
      else cv.Version:=MX_86000;   {Does this work, else test 85h bit 1 ??}
      case (rdinx(SEQ,$C2)  shr 2) and 3 of
    0:cv.mm:=256;
    1:cv.mm:=512;
    2:cv.mm:=1024;
      end;
      addvideo;
    end;
  end;
  wrinx(SEQ,$A7,old);
end;

procedure _ncr;
var x:word;
begin
  if testinx2(SEQ,5,5) then
  begin
    wrinx(SEQ,5,0);        {Disable extended registers}
    if not testinx(SEQ,$10) then
    begin
      wrinx(SEQ,5,1);        {Enable extended registers}
      if testinx(SEQ,$10) then
      begin
    cv.chip:=__ncr;
        cv.clktype:=clk_ext3;
    cv.SubVers:=rdinx(SEQ,8);
    case cv.SubVers shr 4 of
      0:cv.Version:=NCR_77C22;
      1:cv.Version:=NCR_77C21;
      2:if (cv.SubVers and 15)<8 then cv.Version:=NCR_77C22E
                                     else cv.Version:=NCR_77C22Ep;
          3:cv.Version:=NCR_77c32BLT;
    else cv.Version:=NCR_Unknown;
    end;
    cv.features:=ft_rwbank+ft_cursor;
        if cv.Version>=NCR_77c32BLT then cv.features:=cv.features+ft_blit;
    cv.name:=cv.name+' Rev. '+istr(rdinx(SEQ,8) and 15);
        memmode:=_P8;
    if setmode($13,false) then;
    checkmem(64);
    addvideo;
      end;
    end;
  end;
end;

procedure _oak;
var old:word;

begin
  if testinx($3DE,9) or testinx2($3DE,$D,$38) then
  begin
    cv.chip:=__oak;
    cv.features:=ft_rwbank;
    if testinx2($3DE,$23,$1F) then
    begin
      case rdinx($3DE,2) and 6 of
    0:cv.mm:=256;
    2:cv.mm:=512;
    4:cv.mm:=1024;
    6:cv.mm:=2048;
      end;
      if (rdinx($3DE,0) and 2)=0 then cv.Version:=OAK_087
                 else cv.version:=OAK_083;
      {SetDAC(_dac16,'OAK OTI-066HC');  {Cheat}
      cv.clktype:=clk_ext4;
    end
    else begin
      cv.clktype:=clk_ext3;
      cv.SubVers:=inp($3DE) shr 5;
      case cv.SubVers of
    0:cv.Version:=OAK_037;
    2:cv.Version:=OAK_067;
    5:cv.Version:=OAK_077;
    7:cv.Version:=OAK_057;
      else cv.Version:=OAK_Unknown;
      end;

      case rdinx($3DE,$D) shr 6 of
    2:cv.mm:=512;
      1,3:cv.mm:=1024;    {1 might not give 1M??}
      end;
    end;
    addvideo;
  end;
end;

procedure _p2000;
begin
  if testinx2(GRC,$3D,$3F) and tstrg($3D6,$1F) and tstrg($3D7,$1F) then
  begin
    cv.Version:=PR_2000;
    cv.chip:=__p2000;
    cv.features:=ft_rwbank+ft_blit;
    memmode:=_P8;
    if setmode($13,false) then;
    checkmem(32);
    cv.clktype:=clk_ext4;
    addvideo;
  end;
end;

procedure _paradise;
var old,old2:word;
begin
  old:=rdinx(GRC,$F);
  setinx(GRC,$F,$17);   {Lock registers}

  if not testinx2(GRC,9,$7F) then
  begin
    wrinx(GRC,$F,5);      {Unlock them again}
    if testinx2(GRC,9,$7F) then
    begin
      cv.clktype:=clk_ext3;
      old2:=rdinx(crtc,$29);
      modinx(crtc,$29,$8F,$85);   {Unlock WD90Cxx registers}
      if not testinx(crtc,$2B) then cv.Version:=WD_PVGA1A
      else begin
    wrinx(SEQ,6,$48);   {Enable C1x extensions}
    if not testinx2(SEQ,7,$F0) then cv.Version:=WD_90C00
    else if not testinx(SEQ,$10) then
    begin
          if testinx2(crtc,$31,$68) then cv.Version:=WD_90c22
          else if testinx2(crtc,$31,$90) then cv.Version:=WD_90c20A
          else cv.Version:=WD_90C20;
      wrinx(crtc,$34,$A6);
      if (rdinx(crtc,$32) and $20)<>0 then wrinx(crtc,$34,0);
    end
    else begin
          cv.clktype:=clk_ext4;
      cv.features:=ft_rwbank;
      if testinx2(SEQ,$14,$F) then
      begin
            wrinx(crtc,$34,0);   {Disable c2x registers}
            wrinx(crtc,$35,0);   {Disable c2x registers}
        cv.SubVers:=(rdinx(crtc,$36) shl 8)+rdinx(crtc,$37);
        case cv.SubVers of
          $3234:begin
                      cv.Version:=WD_90c24;
                      cv.features:=cv.features+ft_cursor+ft_blit;
                      cv.clktype:=clk_internal;
                      SetDAC(_dacInt,'WD 16bit');
                    end;
          $3236:cv.Version:=WD_90C26;
          $3330:cv.Version:=WD_90c30;
          $3331:begin
                      cv.Version:=WD_90C31;
                      cv.features:=cv.features+ft_cursor+ft_blit;
                    end;
          $3333:begin
                      cv.Version:=WD_90C33;
                      cv.features:=cv.features+ft_cursor+ft_blit+ft_line;
                    end;
        end;
      end
      else if not testinx2(SEQ,$10,4) then cv.Version:=WD_90C10
                      else cv.Version:=WD_90C11;
    end;
      end;
      wrinx(GRC,$F,5);      {Unlock them again}
      case rdinx(GRC,$B) shr 6 of
        2:cv.mm:=512;
        3:cv.mm:=1024;
      end;
      if (cv.Version>=WD_90c33) and ((rdinx(crtc,$3E) and $80)>0) then cv.mm:=2048;
      wrinx(crtc,$29,old2);
      cv.chip:=__WD;
      addvideo;
    end;
  end;
  wrinx(GRC,$F,old);
end;

procedure _realtek;
begin
  if testinx2(crtc,$1F,$3F) and tstrg($3D6,$F) and tstrg($3D7,$F) then
  begin
    cv.chip:=__realtek;
    cv.clktype:=clk_ext3;
    cv.SubVers:=rdinx(crtc,$1A) shr 6;
    case cv.SubVers of
      0:cv.Version:=RT_3103;
      1:cv.Version:=RT_3105;
      2:cv.Version:=RT_3106;
    else cv.Version:=RT_unknown;
    end;
    case rdinx(crtc,$1E) and 15 of
      0:cv.mm:=256;
      1:cv.mm:=512;
      2:if cv.SubVers=0 then cv.mm:=768  else cv.mm:=1024;
      3:if cv.SubVers=0 then cv.mm:=1024 else cv.mm:=2048;
    end;
    cv.features:=ft_rwbank;
    addvideo;
  end;
end;

procedure _s3;
begin
  wrinx(crtc,$38,0);
  if not testinx2(crtc,$35,$F) then
  begin
    wrinx(crtc,$38,$48);
    if testinx2(crtc,$35,$F) then
    begin
      cv.features:=ft_blit+ft_line+ft_cursor;
      cv.SubVers:=rdinx(crtc,$30);
      cv.clktype:=clk_ext4;
      case cv.SubVers of
    $81:cv.Version:=S3_911;
    $82:cv.Version:=S3_924;    {Also known as 911A}
    $90:cv.Version:=S3_928;
    $91:cv.Version:=S3_928C;
    $94:cv.Version:=S3_928D;
        $95:cv.Version:=S3_928E;
    $A0:if (rdinx(crtc,$36) and 2)>0 then cv.Version:=S3_801AB
                         else cv.Version:=S3_805AB;
   $A2..$A4:if (rdinx(crtc,$36) and 2)>0 then cv.Version:=S3_801C
                                         else cv.Version:=S3_805C;
    $A5,$A7:if (rdinx(crtc,$36) and 2)>0 then cv.Version:=S3_801D
                         else cv.Version:=S3_805D;
        $A6:if (rdinx(crtc,$36) and 2)>0 then cv.Version:=S3_801P
                     else cv.Version:=S3_805P;
        $A8:if (rdinx(crtc,$36) and 2)>0 then cv.Version:=S3_801I
                     else cv.Version:=S3_805I;
    $B0:cv.Version:=S3_928PCI;
    $C0:cv.Version:=S3_864;
    $C1:cv.Version:=S3_864P;
    $D0:cv.Version:=S3_964;
    $E0,$E1:case rdinx(crtc,$2E) of   {Not sure of this yet}
              $10:cv.Version:=S3_732;
              $11:cv.Version:=S3_764;
              $80:cv.Version:=S3_866;
              $90:cv.Version:=S3_868;
          $B0,$F0:cv.Version:=S3_968;
            end;
      else cv.Version:=S3_Unknown;
      end;
      if (cv.Version=S3_732) or  (cv.Version=S3_764) then
      begin
        cv.clktype:=clk_internal;
        SetDAC(_dacInt,'S3 Trio');
      end;
      cv.mm:=512;
      if (rdinx(crtc,$36) and $20)=0 then
        if (cv.subvers<$90) then cv.mm:=1024   {911 and 924}
        else case rdinx(crtc,$36) shr 6 of
               0:cv.mm:=4096;
               1:cv.mm:=3072;
               2:cv.mm:=2048;
               3:cv.mm:=1024;
             end;
      cv.chip:=__S3;
      addvideo;
    end;
  end;
end;

procedure _Sierra;
var old,i:word;
begin
  old:=rdinx(SEQ,$11);
  setinx(SEQ,$11,$20);
  if not testinx(SEQ,$15) then
  begin
    i:=rdinx(SEQ,$11);
    outp(SEQ+1,i);
    outp(SEQ+1,i);
    outp(SEQ+1,i and $DF);
    if testinx(SEQ,$15) then
    begin
      setinx(SEQ,$11,$20);
      cv.chip:=__Acer;
      case rdinx(SEQ,7) shr 5 of
        4:cv.version:=SC_15064;
      else cv.version:=SC_Unknown;
      end;
      if setmode($13,false) then;
      checkmem(64);
      addvideo;
    end;
  end;
  wrinx(SEQ,$11,old);
end;

procedure _SiS;
var old:word;
begin
  old:=rdinx(SEQ,5);
  wrinx(SEQ,5,0);
  if rdinx(SEQ,5)=$21 then
  begin
    wrinx(SEQ,5,$86);
    if rdinx(SEQ,5)=$A1 then
    begin
      cv.chip:=__SiS;
      cv.Version:=SIS_201;
      case rdinx(SEQ,$F) and 3 of
        0:cv.mm:=1024;
        1:cv.mm:=2048;
        2:cv.mm:=4096;
      end;
      cv.dactype:=_dacInt;
      cv.clktype:=clk_ext4;
      cv.features:=ft_cursor+ft_rwbank;
      addvideo;
    end;
  end;
  wrinx(SEQ,5,old);
end;

procedure _trident;
var old,val,Xseg,x:word;
  Phadr:longint;
begin
  wrinx(SEQ,$B,0);           {Force old mode}
  cv.SubVers:=inp(SEQ+1);    { ---  new mode}
  old:=rdinx(SEQ,$E);
  outp(SEQ+1,old xor $55);
  val:=inp(SEQ+1);
  outp(SEQ+1,old);
  if ((val xor old) and 15)=7 then  {Check for inverting bit 1}
  begin
    outp($3c5,old xor 2);   (* Trident should restore bit 1 reversed *)
    case cv.SubVers of
        1:cv.Version:=TR_8800BR;   {This'll never happen - no new mode}
        2:cv.Version:=TR_8800CS;
        3:cv.Version:=TR_8900B;
    4,$13:cv.Version:=TR_8900C;
      $23:cv.Version:=TR_9000;
      $33:if (rdinx(crtc,$28) and $80)>0 then cv.Version:=TR_8900CL
                {Does this work?}        else cv.Version:=TR_9000C;
      $43:cv.Version:=TR_9000i;
      $53:cv.Version:=TR_9200CXr;
      $63:cv.Version:=TR_LCD9100B;
      $73:cv.Version:=TR_GUI9420;   {Haven't seen this yet ?}
      $83:cv.Version:=TR_LX8200;
      $93:cv.Version:=TR_9400CXi;
      $A3:cv.Version:=TR_LCD9320;
      $C3:cv.Version:=TR_GUI9420;
      $D3:cv.Version:=TR_GUI9660;
      $E3:cv.Version:=TR_GUI9440;
      $F3:cv.Version:=TR_GUI9430;  {not quite sure}
          {The $63, $73, $83, $A3 entries are still in doubt}
    else cv.Version:=TR_Unknown;
    end;
    case cv.version of
      TR_8800BR,
      TR_8800CS,
       TR_8900B:cv.clktype:=clk_ext3;
      TR_9200CXr,TR_9400CXi,TR_GUI9420,TR_GUI9430
               :begin
                  cv.clktype:=clk_ext4;
                  cv.dactype:=_dacInt;
                end;
     TR_GUI9440:begin
                  cv.clktype:=clk_internal;
                  cv.dactype:=_dacInt;
                end;
    else cv.clktype:=clk_ext4;
    end;
    if (cv.version>=TR_9000C) then cv.features:=cv.features+ft_rwbank;
    if (cv.version>=TR_GUI9440) then cv.features:=cv.features+ft_cursor;
    if cv.version=TR_9000i then setDAC(_dac16,'Trident 9000i');
    cv.chip:=__trid;
    if (pos('Zymos Poach 51',getbios(0,255))>0) or
       (pos('Zymos Poach 51',getbios(230,255))>0) then
    begin
      cv.name:=cv.name+' (Zymos Poach)';
      cv.chip:=__poach;
    end;
    case rdinx(crtc,$1F) and 3 of
      0:cv.mm:=256;
      1:cv.mm:=512;
      2:cv.mm:=768;
      3:if (cv.Version>=TR_8900CL) and ((rdinx(crtc,$1F) and 4)>0) then
             cv.mm:=2048
        else cv.mm:=1024;
    end;
    if (cv.SubVers=2) and (tstrg($2168,$F)) then
    begin
      cv.clktype:=clk_ext2;
      cv.Version:=TR_IITAGX;
      cv.mm:=512;   {Might be able to address 1Mb, but scroll etc only works}
      addvideo;     {in the first 512K anyhow !}

      cv.IOadr:=$2160;
      cv.chip:=__AGX;
      old:=inp(cv.IOadr);
      modreg(cv.IOadr,7,4); {Enable XGA mode}
      if testinx2(cv.IOadr+10,$7F,$30) then cv.version:=IIT_AGX1x
      else if testinx2(cv.IOadr+10,$71,$F) then cv.version:=IIT_AGX16
      else if (rdinx(cv.IOadr+10,$6C) and 1)>0 then cv.version:=IIT_AGX15
                                               else cv.Version:=IIT_AGX14;
      if (rdinx(cv.IOadr+10,$6D) and 1)>0 then cv.Xseg:=$B1F0 else cv.Xseg:=$D1F0;
      outp(cv.IOadr,old);
      if cv.Version>=IIT_AGX14 then cv.clktype:=clk_ext5
                               else cv.clktype:=clk_ext4;
      memmode:=_p8;
      if setmode($65,false) then;
      checkmem(32);
      cv.features:=ft_blit+ft_line+ft_cursor;
      Phadr:=$FF800000;
      cv.flags:=cv.flags and (not FLG_StdVGA);
    end;
    addvideo;
  end
  else begin  {Trident 8800BR tests}
    if (cv.subvers=1) and testinx2(SEQ,$E,6) then
    begin
      cv.Version:=TR_8800BR;
      cv.chip:=__trid;
      if (rdinx(crtc,$1F) and 2)>0 then cv.mm:=512;
      addvideo;
    end;
  end;
end;

procedure _tseng;
var x,vs:word;
  s:string;
begin
  outp($3BF,3);
  outp(crtc+4,$A0);    {Enable Tseng 4000 extensions}
  if tstrg($3CD,$3F) then
  begin
    cv.chip:=__Tseng;
    cv.features:=ft_rwbank;
    cv.clktype:=clk_ext5;
    if testinx2(crtc,$33,$F) then
    begin
      if tstrg($3CB,$33) then
      begin
        cv.features:=cv.features+ft_cursor+ft_blit;
    cv.SubVers:=rdinx($217A,$EC);
    case cv.SubVers shr 4 of
      0:cv.Version:=ET_4W32;
          1:cv.Version:=ET_4W32i_a;
          2:cv.Version:=ET_4W32p_a;
          3:cv.Version:=ET_4W32i_b;
          5:cv.Version:=ET_4W32p_b;
          6:cv.Version:=ET_4W32p_d;
          7:cv.Version:=ET_4W32p_c;
         11:cv.Version:=ET_4W32i_c;
    else Unk(ET_4Unk,cv.SubVers);
    end;
    case rdinx(crtc,$37) and $9 of
           0:cv.mm:=2048;
       1:cv.mm:=4096;
     {  9:mm:=256;}
       8:cv.mm:=512;
       9:cv.mm:=1024;
    end;
        if cv.version>=ET_4W32p_a then cv.features:=cv.features or ft_line;
        if (cv.Version<>ET_4W32) and ((rdinx(crtc,$32) and $80)>0) then
          cv.mm:=cv.mm*2;
      end
      else begin
    cv.Version:=ET_4000;
    case rdinx(crtc,$37) and $B of
     3,9:cv.mm:=256;
      10:cv.mm:=512;
      11:cv.mm:=1024;
    end;
        cv.subvers:=0;
        for x:=0 to 10 do
        begin
          s:=getbios(x*230,255);
          if pos('Genoa Systems',s)>0 then cv.subvers:=TS_Genoa7900
          else if pos('SpeedSTAR',s)>0 then cv.subvers:=TS_SpeedStar;
        end;
      end;
    end
    else begin
      cv.Version:=ET_3000;
      if setmode($13,false) then;
      x:=inp(CRTC+6);
      x:=rdinx($3C0,$36);
      outp($3C0,x or $10);
      case (rdinx(GRC,6) shr 2) and 3 of
       0,1:vs:=SegA000;
     2:vs:=SegB000;
     3:vs:=SegB800;
      end;

      meml[vs:1]:=$12345678;
      if memw[vs:2]=$3456 then cv.mm:=512;

      wrinx($3C0,$36,x);     {reset value and reenable DAC}
    end;
    addvideo;
  end;
end;

procedure _UMC;
var old:integer;
begin
  old:=inp($3BF);
  outp($3BF,3);
  if not testinx(SEQ,6) then
  begin
    outp($3BF,$AC);
    if testinx(SEQ,6) then
    begin
      cv.chip:=__UMC;
      cv.clktype:=clk_ext3;
      case rdinx(SEQ,7) shr 6 of
    1:cv.mm:=512;
      2,3:cv.mm:=1024;
      end;
      if testinx2(crtc,$35,$F) then
      begin
        cv.version:=UMC_418;
        if ((rdinx(GRC,$B) and $7F)=$2A) then cv.mm:=1024;
      end
      else cv.version:=UMC_408;
      cv.features:=ft_rwbank;
      addvideo;
    end;
  end;
  outp($3BF,old);
end;


procedure _video7;
var ram:string[10];
  old:integer;
begin
  vio($6f00);
  if rp.bx=$5637 then
  begin
    vio($6f07);
    if rp.ah<128 then ram:='VRAM' else ram:='FASTWRITE';

 (* old:=rdinx(crtc,$C);
  wrinx(crtc,$C,old);
  wrinx($3C4,6,$EA);    {Enable Extensions}
  if rdinx(crtc,$1F)=(old XOR $EA) then
  begin
    wrinx(crtc,$C,old XOR $FF);
    if rdinx(crtc,$1F)=(old XOR $15) then
    begin
      cv.SubVers:=(rdinx($3C4,$8F) shl 8)+rdinx($3C4,$8E);

  wrinx(crtc,$C,old); *)

    wrinx(SEQ,6,$EA);  {Enable extensions}
    cv.Subvers:=(rdinx(SEQ,$8F) shl 8)+rdinx(SEQ,$8E);
    case cv.Subvers of
  $8000..$FFFF:cv.Version:=V7_VEGA;
  $7000..$70FF:cv.Version:=V7_208_13;    {Fastwrite}
  $7140..$714F:cv.Version:=V7_208A;      {1024i}
     $7151:cv.Version:=V7_208B;      {VRAm II b}
     $7152:cv.Version:=V7_208CD;     {VRAm II c}
     $7760:cv.Version:=V7_216BC;
     $7763:cv.Version:=V7_216D;
     $7764:cv.Version:=V7_216E;
     $7765:cv.Version:=V7_216F;
    else cv.Version:=V7_Unknown;
    end;
    case rp.ah and 127 of
      2:cv.mm:=512;
      4:cv.mm:=1024;
    end;
    cv.chip:=__video7;
    cv.features:=ft_cursor;
    if cv.Version>=V7_208A then
    begin
    {  cv.Features:=cv.features+ft_rwbank; {Don't work }
      cv.clktype:=clk_ext4;
    end;
    addvideo;
  end;
end;


  {Sets the Extention & Bank enable flags in SEQ index $11}
function WeitekEnable(flag:word):word;
var x,y:word;
begin
  disable;
  x:=rdinx(SEQ,$11);
  for y:=1 to 10 do; {delay}
  outp(SEQ+1,x);
  for y:=1 to 10 do;
  outp(SEQ+1,x);
  for y:=1 to 10 do;
  WeitekEnable:=x;
  x:=inp(SEQ+1);
  for y:=1 to 10 do;
  outp(SEQ+1,(x and $9F) or flag);
  WeitekEnable:=x;
  enable;
end;


procedure _Weitek;
var old,x,y,z:word;
  rr:array[0..$1FF] of byte;
begin
  old:=WeitekEnable($60);   {Disable}
  if not testinx(SEQ,$12) then
  begin
    x:=WeitekEnable(0);     {Enable}
    if testinx(SEQ,$12) and tstrg($3CD,$FF) then
    begin
      cv.chip:=__Weitek;
      cv.features:=ft_rwbank;
      cv.SubVers:=rdinx(SEQ,7);
      cv.clktype:=clk_ext3;
      case cv.subvers shr 5 of
        1:begin
            cv.Version:=WT_5186;  {Should check for version and memory}
          (*  if (rdinx(SEQ,$12) and $80)>0 then
               cv.mm:=512;   {Untested} *)
          end;
        2:begin
            outp($9100,0);
            z:=inp($9104);
            outp($9100,1);
            z:=(inp($9104) shl 8)+z;
            if (z=$100E) then
            begin
              cv.Version:=WT_P9100;
              cv.mm:=1024;   {Hm}
            end
            else begin
              cv.Version:=WT_5286;
              case rdinx(SEQ,$12) shr 6 of
                0:cv.mm:=256;
                1:cv.mm:=512;
                2:cv.mm:=1024;
              end;
            end;
          end;
      else cv.Version:=WT_Unk;
      end;
      addvideo;
      x:=WeitekEnable($60);  {dis. VGA}
      z:=rdinx(SEQ,$12);
      clrinx(SEQ,$12,$80);
      setinx(SEQ,$12,$10);
      outp($3CD,$10);

      move(mem[SegA000:0],rr,$200);
      wrinx(SEQ,$12,z);
    end;
  end;
  wrinx(SEQ,$11,old);
end;

procedure _XGA;
var p:pointer;
 posbase,cardid,xga_base,x,cx:word;
 temp0,temp1,temp2,temp3:byte;
begin
  getintvec($15,p);
  if (seg(p^)<>0) then
  begin
    rp.ax:=$C400;
    rp.dx:=$ffff;
    intr($15,rp);
    if not odd(rp.flags) and (rp.dx<>$ffff) then
    begin
      posbase:=rp.dx;
      for cx:=0 to 9 do
      begin
    disable;   (* CLI -  Disable interrupts *)
    if cx=0 then outp($94,$DF)
    else begin
      rp.ax:=$C401;
      rp.bx:=cx;
      intr($15,rp);
    end;
    cardid:=inpw(posbase);
    temp0:=inp(posbase+2);
    temp1:=inp(posbase+3);
    temp2:=inp(posbase+4);
    temp3:=inp(posbase+5);
    if cx=0 then outp($94,$FF)
    else begin
      rp.ax:=$C402;
      rp.bx:=cx;
      intr($15,rp);
    end;
    enable;   (* STI -  Enable interrupts *)
    if (cardid>=$8FD8) and (cardid<=$8FDB) then
    begin
      cv.IOadr:=$2100+(temp0 and $E)*8;
      x:=rdinx(cv.IOadr+10,$52) and 15;
      if (x<>0) and (x<>15) then
      begin
        cv.chip:=__XGA;
        outp(cv.IOadr+4,0);
      {  outp(cv.IOadr,4);
        checkmem(16); }
            cv.mm:=1024;
        case cardid of
         $8FDA:cv.Version:=XGA_NI;
         $8FDB:cv.Version:=XGA_org;
        end;

        cv.Xseg:=(temp0 shr 4)*$2000+$C1C0+(temp0 and $E)*4;
        cv.Phadr:=((temp2 and $FE)*word(8)+(temp0 and $E))*longint($200000);
        addvideo;
      end;
    end;
      end;
    end;
  end;
end;

procedure _yamaha;
begin
  if testinx2(crtc,$7C,$7C) then
  begin
    cv.Version:=YA_6388;
    addvideo;
  end;
end;

procedure _xbe;
var
  x:word;
  xbe0:_xbe0;
  xbe1:_xbe1;

begin
  viop($4E00,0,0,0,@xbe0);
  if (rp.ax=$4E) and (xbe0.sign=$41534556) then
  begin
    for x:=0 to xbe0.xgas-1 do
    begin
      viop($4E01,0,0,x,@xbe1);
      if (rp.ax=$4E) then
      begin
    cv.chip:=__xbe;
        cv.features:=ft_blit+ft_line;
    cv.mm:=xbe1.memory*longint(64);
    cv.id:=x;
    cv.IOadr :=xbe1.iobase;
    cv.Xseg  :=xbe1.memreg shr 16;
    cv.Phadr :=xbe1.vidadr;
    cv.name  :=gtstr(xbe1.oemadr^);
    UNK(VS_XBE,xbe0.vers);
    addvideo;
      end;
    end;
  end;
end;

procedure _vesa;
var
  vesarec:_vbe0;
  x:word;
begin
  viop($4f00,0,0,0,@vesarec);
  if (rp.ax=$4f) and (vesarec.sign=$41534556) then
  begin
    cv.chip:=__vesa;
    cv.mm:=vesarec.mem*longint(64);
    cv.name:=gtstr(vesarec.oemadr^);
    UNK(VS_VBE,vesarec.vers);
    cv.dactype:=_dac8;    {Dummy, to keep Cirrus 542x out of trouble}
    addvideo;
  end;
end;


type
  pel=record
    index,red,green,blue:byte;
      end;

procedure readpelreg(index:word;var p:pel);
begin
  p.index:=index;
  disable;
  outp($3C7,index);
  p.red  :=inp($3C9);
  p.blue :=inp($3C9);
  p.green:=inp($3C9);
  enable;
end;

procedure writepelreg(var p:pel);
begin
  disable;
  outp($3C8,p.index);
  outp($3C9,p.red);
  outp($3C9,p.blue);
  outp($3C9,p.green);
  enable;
end;

function setcomm(cmd:word):word;
begin
  dac2comm;
  outp($3c6,cmd);
  dac2comm;
  setcomm:=inp($3c6);
end;

function dacis8bit:boolean;
var
  pel2,x,y,z,v:word;
  pel1:pel;
begin
  pel2:=inp($3C8);
  readpelreg(255,pel1);
  v:=pel1.red;
  pel1.red:=255;
  writepelreg(pel1);
  readpelreg(255,pel1);
  x:=pel1.red;
  pel1.red:=v;
  writepelreg(pel1);
  outp($3C8,pel2);
  dacis8bit:=(x=255);
end;

procedure testdac;      {Test for type of DAC}
var
  x,y,z,v,oldcomm,oldpel,notcomm:word;
  dac8,dac8now:boolean;
  data:array[9..12] of byte;

procedure waitforretrace;
begin
  repeat until (inp(CRTC+6) and 8)=0;
  repeat until (inp(CRTC+6) and 8)>0;    {Wait until we're in retrace}
end;

procedure SetDACCmd(cmd:integer);
begin
  dac2comm;
  outp($3C6,cmd);
  dac2pel;
end;


function testdacbit(bit:word):boolean;
var v:word;
begin
  dac2pel;
  outp($3C6,oldpel and (bit xor $FF));
  dac2comm;
  disable;
  outp($3C6,oldcomm or bit);
  dac2comm;
  v:=inp($3C6);
  outp($3C6,v and (bit xor $FF));
  enable;
  testdacbit:=(v and bit)<>0;
end;

function rdSCdac(Inx:word):word;
begin
  dac2comm;
  outp($3C6,inp($3C6) or $10);
  rdSCdac:=rdinx($3C7,inx);
  dac2comm;
  outp($3C6,inp($3C6) and $EF);
  dac2pel;
end;

procedure wrBTinx(inx,val:word);
var x:word;
begin
  dac2comm;
  x:=daccomm;
  outp($3C6,1);
 { dac2pel;}
  outp($3C8,Inx);
  outp($3C6,val);
  dac2comm;
  outp($3C6,x and $FE);
  dac2pel;
end;

function rdBTinx(Inx:word):word;
var x:word;
begin
  dac2comm;
  x:=daccomm;
  outp($3C6,1);
 { dac2pel;}
  outp($3C8,Inx);
  rdBTinx:=inp($3C6);
  dac2comm;
  outp($3C6,x and $FE);
  dac2pel;
end;


var zz:integer;
  t:text;
begin
  setDAC(_dac8,'Normal');
  dac2comm;
  oldcomm:=inp($3c6);
  dac2pel;
  oldpel:=inp($3c6);

  if cv.dactype=_dac8 then
  begin
    dac2comm;
    outp($3C6,0);
    dac8:=dacis8bit;
    dac2pel;

    notcomm:=oldcomm xor 255;
    outp($3C6,notcomm);
    dac2comm;
    v:=inp($3C6);
    if v<>notcomm then    {We have a "Hidden Command" register}
    begin
      dac2pel;
      dac2comm;
      x:=inp($3C6);
      x:=inp($3C6);
      y:=inp($3C6);
      z:=inp($3C6);
      dac2pel;
      if (x=$84) and (y=$98) then
      begin
        if z=$4F then setDAC(_dacICW516,'IC Works W30c516')
        else if setcomm($A)=0 then setDAC(_dacATT2498,'ATT 22c498')
                              else setDAC(_dacATT1498,'ATT 21c498');
      end
      else begin
        setDACcmd($10);
        if rdinx($3C7,9)=$53 then
        begin
          x:=rdinx($3C7,10);
          x:=x*256+rdinx($3C7,11);
          case x of     {Looks like the 15021 & 25 are the only values}
            15021:setDAC(_dacSC15021,'SC15021');
            15025:setDAC(_dacSC15025,'SC15025');
          else setDAC(_dacSC15021,'Unknown SC 15xxx');
          end;
        end;
        setDACcmd(oldcomm);
      end;
      if cv.dactype=_dac8 then
      begin
        setDACcmd($10);
        dac2comm;
        x:=inp($3C6);
        outp($3C6,0);
        outp($3C6,0);
        if inp($3C6)=$44 then
          case inp($3C6) of
            0:setDAC(_dacSTG1700,'STG1700');
            2:setDAC(_dacSTG1702,'STG1702');
            3:begin
                setDAC(_dacSTG1703,'STG1703');
                cv.clktype:=clk_STG;
              end;
          else setDAC(_dacSTG1700,'Unknown STG');
          end;
        setDACcmd(oldcomm);
      end;
      if cv.dactype=_dac8 then
      begin
        dac2pel;
        x:=inp($3C6);
        x:=inp($3C6);
        x:=inp($3C6);
        x:=inp($3C6);
        if (x and $F0)=$70 then
        begin
          setDAC(_dacS3_716,'S3 86c716 (SDAC)');
          cv.clktype:=clk_sdac;
        end;
        dac2pel;
      end;
      if cv.dactype=_dac8 then
      begin
        dac2comm;
        if daccomm=$31 then setDAC(_dacALG1301,'ALG1301');
        dac2pel;
      end;
      if cv.dactype=_dac8 then
        if (setcomm($E0) and $E0)<>$E0 then
        begin
          dac2pel;
          x:=inp($3C6);
          repeat
        y:=x;         {wait for the same value twice}
        x:=inp($3C6);
          until (x=y);
          z:=x;
          dac2comm;
          if daccomm<>$8E then
          begin                 {If command register=$8e, we've got an SS24}
        y:=8;
        repeat
          x:=inp($3C6);
          dec(y);
        until (x=$8E) or (y=0);
          end
          else x:=daccomm;
          if x=$8e then setDAC(_dacMU1880,'SS24')
               else setDAC(_dacSC486,'Sierra SC11486');
          dac2pel;
        end
        else begin
          if (setcomm($60) and $E0)=0 then
          begin
            if (setcomm(2) and 2)>0 then setDAC(_dacATT490,'ATT 20c490')
                                    else setDAC(_dacATT493,'ATT 20c493');
          end
          else begin  {Bit 5-7 fully r/w}
            dac2pel;
            outp($3C6,notcomm);     {PEL register}
        x:=setcomm(oldcomm);
        if inp($3C6)=notcomm then     {Falls back to PEL register}
        begin                         {after 1st read}
              x:=setcomm($FC);
              if x<>$FC then
                case x of
                  $E2:setDAC(_dacALG1201,'ALG1201');
                  $E0:setDAC(_dacICS5301,'ICS 5301');
                  $F4:setDAC(_dacS3_708,'S3/ICS 86c708 GenDAC');
                else
                  if testdacbit($F0) then setDAC(_dacUMC188,'UMC UM70c188')
                                     else setDAC(_dacADAC1,'Acumos ADAC1');
                end
          else begin  {All 8 bits fully r/w}
            dac8now:=dacis8bit;
            dac2comm;
            outp($3C6,(oldcomm or 2) and $FE);
            dac8now:=dacis8bit;
            if dac8now then
                begin
              if dacis8bit then
                  begin
                    x:=setcomm(oldcomm or $10);
                    dac2comm;
                    x:=inp($3C6);
                    outp($3C6,1);
                    x:=x;  {delay}
                    outp($3C6,0);
                    if inp($3C6)=0 then setDAC(_dacATT491,'ATT 20c491')
                  end
                end
                 { else setDAC(_dacCL24,'Cirrus 24bit DAC')}
            else
                  if trigdac=$B3 then
                  begin
                    setDAC(_dacCH8391,'CHRONTEL CH8391');
                    cv.clktype:=clk_CHRON;
                  end
                  else setDAC(_dacATT492,'ATT 20c492');
          end;
        end
        else begin
          {if trigdac=notcomm then setDAC(_dacCL24,'Cirrus 24bit DAC')
          else} begin
            dac2pel;
            outp($3C6,$FF);
            case trigdac of
                  $44:begin
                        setDAC(_dacMU9910,'MUSIC MU9C9910');
                        cv.clktype:=CLK_MUSIC;
                      end;
              $82:setDAC(_dacMU4910,'MUSIC MU9C4910');
              $8E:setDAC(_dacMU1880,'MUSIC MU9C1880 (SS2410)');
            else begin
                  if setcomm(1)=$AA then setDAC(_dacALG1201,'ALG1201')
                  else begin
                         dac2comm;
                         if daccomm=$C0 then
                         begin
                           setDAC(_dacCH8398,'CH8398');
                           cv.clktype:=clk_CHRON;
                         end
                         else
                           if testdacbit($10) then
                           begin
                             outp($3C8,2);
                             SetDACcmd(oldcomm or 2);
                             dac8now:=dacis8bit;
                             SetDACcmd(oldcomm and $FD);
                             if dac8now then    {The Bt481 ends here too}
                             begin
                               outp($3C8,0);
                               SetDACcmd(oldcomm or 2);
                               dac8now:=dacis8bit;
                               SetDACcmd(oldcomm and $FD);
                               if dac8now then setDAC(_dacTR8001,'Trident TKD8001')
                                          else setDAC(_dacBt481,'Bt481');
                             end
                             else setDAC(_dac16,'OAK 66HC');
                           end
                           else begin
                             dac2pel;
                             outp($3C6,$FF);
                             dac2comm;
                             outp($3C6,0);
                             dac2pel;
                             dac2comm;
                             outp($3C6,$7F);
                             dac2comm;
                             x:=inp($3C6);
                             dac2comm;
                             dac2comm;
                             outp($3C6,$FF);
                             dac2comm;
                             v:=inp($3C6);
                             dac2comm;
                             outp($3C6,oldcomm);
                             dac2pel;
                             if (x=$60) and (v=$E0) then setDAC(_dac16,'UMC 70c178')
                             else if (x=$7F) and (v=$FE) then setDAC(_dac16,'Sierra SC11487')
                                                    else setDAC(_dac15,'Sierra Sc11483');
                           end;
                       end;
            end;
          end;
        end;
          end;
        end;

      end;

      dac2comm;
      outp($3c6,oldcomm);
    end;
    dac2pel;
    outp($3c6,oldpel);

  end;

  if (cv.dactype=_dac8) then
  begin
    oldpel :=rdDACreg(dacSTDpelMask) xor $FF;
    oldcomm:=rdDACreg(dacSTDpelMask+4);
    x      :=rdDACreg(dacSTDpelMask+8);
    wrDACreg(dacSTDpelMask,oldpel);
    y :=rdDACreg(dacSTDpelMask+4);
    z :=rdDACreg(dacSTDpelMask+8);
    zz:=rdDACreg(dacSTDpelMask);
    if (zz=oldpel) and (y<>oldpel) or (z<>oldpel) then
    begin   { Either RS2 or RS3 finds a register <> $3C6,
              We have an advanced DAC and access to it! }
      wrDACreg(dacSTDpelMask,0);
      wrDACreg(dacTLCtest,3);
      case rdDACreg(dacTLCtest) of
        $75:setDAC(_dacTLC34075,'TLC34075');
        $76:setDAC(_dacTLC34076,'TLC34076');
      else
        if cv.chip=__S3 then
        begin
          outpw(crtc,$A539);
          y:=rdinx(crtc,$5C);   {Force TI mode}
          clrinx(crtc,$5C,$20);
          wrDACreg(dacTVPindex,6);
          z:=rdDACreg(dacTVPdata);
          wrDACreg(dacTVPdata,z and $7F);
        end;
        x:=rdDACreg(dacTVPindex);
        wrDACreg(dacTVPindex,$3F);
        y:=rdDACreg(dacTVPdata);
        wrDACreg(dacTVPdata,y xor $FF);
        z:=rdDACreg(dacTVPdata);
        if z<>y then  {Must be read-only for TVP}
          wrDACreg(dacTVPdata,y)
        else
          case y of
            $10:setDAC(_dacTVP3010,'TVP 3010');
            $20:setDAC(_dacTVP3020,'TVP 3020');
            $25:begin
                  setDAC(_dacTVP3025,'TVP 3025');
                  cv.clktype:=clk_TVP302x;
                end;
          end;
        wrDACreg(dacTVPindex,x);
        if cv.dactype=_dac8 then
        begin
          x:=rdDACreg(dacTVP6index);
          wrDACreg(dacTVP6index,$3F);
          y:=rdDACreg(dacTVP6data);
          wrDACreg(dacTVP6data,y xor $FF);
          z:=rdDACreg(dacTVP6data);
          if z<>y then  {Must be read-only for TVP}
            wrDACreg(dacTVP6data,y)
          else
            case y of
              $26:begin
                    setDAC(_dacTVP3026,'TVP 3026');
                    cv.clktype:=clk_TVP302x;
                  end;
            end;
          wrDACreg(dacTVP6index,x);
        end;
        if cv.chip=__S3 then
        begin
          wrDACreg(dacTVPindex,6);
          wrDACreg(dacTVPdata,z);
          outpw(crtc,$A539);
          wrinx(crtc,$5C,y);
        end;
        if (cv.dactype=_dac8) then
        begin
          x:=rdDACreg(dacHIcmd);
          wrDACreg(dacHIcmd,x and $FE);
          y:=rdDACreg(dacSTDpelMask);
          wrDACreg(dacHIcmd,x or 1);   {Switch to Bt481 Indexed}
          wrDACreg(dacSTDwrInx,dacBTIipixm);
          wrDACreg(dacSTDpelMask,y xor $55);
          z:=rdDACreg(dacSTDpelMask);
          wrDACreg(dacSTDwrInx,dacBTIcurX);
          wrDACreg(dacSTDpelMask,y xor $AA);
          v:=rdDACreg(dacSTDpelMask);
          wrDACreg(dacSTDwrInx,dacBTIipixm);
          zz:=rdDACreg(dacSTDpelMask);
          wrDACreg(dacHIcmd,x and $FE); {Back to std regs}
          if (y=rdDACreg(dacSTDpelMask)) and (z=(y xor $55)) then
          begin
            if v=(y xor $AA) then setDAC(_dacBt481,'Bt482')
                             else setDAC(_dacBt482,'Bt481');
          end
          else begin
            x:=rdDACreg(dacIBMind0);
            wrDACreg(dacIBMind1,0);
            wrDACreg(dacIBMind0,dacIBMiRev);
            y:=rdDACreg(dacIBMdata);
            wrDACreg(dacIBMind0,dacIBMiId);
            y:=y+256*rdDACreg(dacIBMdata);
            if (y>$FF) and (y<$2FF) then  {Range ??}
            begin
              wrDACreg(dacIBMind0,dacIBMiRev);
              wrDACreg(dacIBMdata,y xor $FF);
              wrDACreg(dacIBMind0,dacIBMiId);
              wrDACreg(dacIBMdata,hi(y) xor $FF);
              wrDACreg(dacIBMind0,dacIBMiRev);
              z:=rdDACreg(dacIBMdata);
              wrDACreg(dacIBMind0,dacIBMiId);
              z:=z+256*rdDACreg(dacIBMdata);
              if (y=z) then
              begin
                case y of
                  $2F0:SetDAC(_dacIBM524,'IBM RGB524');
                else SetDAC(_dacIBM524,'Unknown IBM RGB');
                end;
                cv.clktype:=clk_IBM52x;
              end
              else begin
                wrDACreg(dacIBMind0,dacIBMiRev);
                wrDACreg(dacIBMdata,y);
                wrDACreg(dacIBMind0,dacIBMiId);
                wrDACreg(dacIBMdata,hi(y));
              end;
            end
          end;
        end;
      end;

      if cv.dactype=_dac8 then
      begin
        wrDACreg(dacSTDwrInx,0);  {Force the Bt485 status register}
        wrDACreg(dacBTcmd0,rdDACreg(dacBTcmd0) and $7F);
        x:=rdDACreg(dacBTstat);
        case x and $F0 of
          $40:setDAC(_dacATT504,'AT&T20c504');
          $D0:setDAC(_dacATT505,'AT&T20c505');
     $80..$B0:begin
                y:=rdDACreg(dacBTcmd0);
                wrDACreg(dacBTcmd0,y or $80);  {Enable STat/Cmd3}
                wrDACreg(dacSTDwrInx,1);  {Force the cmd3 reg}
                z:=rdDACreg(dacBTstat);
                if z=x then
                begin
                  wrDACreg(dacBTstat,x xor $55);
                  wrDACreg(dacSTDwrInx,0);  {Force the stat reg}
                  v:=rdDACreg(dacBTstat);
                  wrDACreg(dacSTDwrInx,1);  {Force the stat reg}
                  wrDACreg(dacBTstat,z);
                  if v=x then z:=x+1;  {Ie. Bt485}
                end;
                wrDACreg(dacBTcmd0,y);
                if x=z then setDAC(_dacBT484,'Bt484')
                       else setDAC(_dacBT485,'Bt485');
              end;
        else
          x:=rdDACreg(0);
          y:=rdDACreg(4);
          wrDACreg(0,x XOR $FF);
          if rdDACreg(4)<>y then setDAC(_dacBT477,'Bt477');
                            {else setDAC(_dacIBM525,'IBM RGB525')}

        end;
      end;
    end;
    wrDACreg(dacSTDpelMask,oldpel);
  end;
  clearDACpage;



  if cv.dactype=_dac8 then
  begin
    WaitforRetrace;
    outp($3C8,222);
    outp($3C9,$43);
    outp($3C9,$45);
    outp($3C9,$47);    {Write 'CEGEDSUN' + mode to DAC index 222}
    outp($3C8,222);
    outp($3C9,$45);
    outp($3C9,$44);
    outp($3C9,$53);
    outp($3C8,222);
    outp($3C9,$55);
    outp($3C9,$4E);
    outp($3C9,13);     {Should be in CEG mode now}
    outp($3C6,255);
    x:=(inp($3c6) shr 4) and 7;
    if x<7 then
    begin
      setDAC(_dacCEG,'Edsun CEG rev. '+chr(x+48));
      WaitforRetrace;
      outp($3C8,223);
      outp($3C9,0);    {Back in normal dac mode}
    end;
  end;
end;


procedure findbios;     {Finds the most likely BIOS segment}
var
  score:array[0..7] of byte;
  x,y:word;
begin
  biosseg:=$c000;
  for x:=0 to 6 do score[x]:=1;
  for x:=0 to 7 do
  begin
    rp.bh:=x;
    vio($1130);
    if (rp.es>=$c000) and ((rp.es and $7ff)=0) then
      inc(score[(rp.es-$c000) shr 11]);
  end;

  for x:=0 to 6 do
  begin
    y:=$c000+(x shl 11);
    if (memw[y:0]<>$aa55) or (mem[y:2]<48) then
      score[x]:=0;                       {fail if no rom}
  end;
  for x:=6 downto 0 do
    if score[x]>0 then
      biosseg:=$c000+(x shl 11);
end;

type
  fnctyp=procedure;

const
  chps=30;
  chptype:array[1..chps] of byte=(__chips,__WD,__Video7
            ,__Everex,__Trid,__ati,__Ahead,__NCR,__S3,__ALG,__ARK
            ,__Cir54,__Cir64,__MXIC,__UMC,__Genoa,__Weitek,__SIS
            ,__Tseng,__Realtek,__P2000,__Acer,__SC,__Alli
            ,__Yamaha ,__Matrox,__Oak,__Cirrus,__Compaq,__HMC);

(* Known test ordering requirements:

  UMC before Genoa, otherwise the UMC will be ID'd as Genoa 6400
  C&T before HMC, as HMC test disturbs C&T
  MXIC before Tseng, as Tseng test disturbs MXIC
  SiS before Tseng, as the SiS will be ID'd as a Tseng
*)


procedure findvideo;
var  old,chp,vid1:word;

begin
  vids:=0;
  cv.dactype:=_dac0;
  cv.features:=0;
  cv.flags:=0;
  if odd(inp($3CC)) then CRTC:=$3D4 else CRTC:=$3B4;
  if dotest[__VESA] then _vesa;
  if dotest[__XBE] then _xbe;
  if dotest[__XGA] then _XGA;
  _Imagine;

  _crt:='';
  cv.chip:=__none;
  secondary:='';
  cv.name:='';
  video:='none';
  rp.bx:=$1010;
  vio($1200);
  if rp.bh<=1 then
  begin
    video:='EGA';
    cv.chip:=__ega;

    cv.mm:=rp.bl;
    vio($1a00);
    if rp.al=$1a then
    begin
      if (rp.bl<4) and (rp.bh>3) then
      begin
    old:=rp.bl;
    rp.bl:=rp.bh;
    rp.bh:=old;
      end;
      video:='MCGA';
      case rp.bl of
    2,4,6,10:_crt:='TTL Color';
    1,5,7,11:_crt:='Monochrome';
        8,12:_crt:='Analog Color';
      end;
      case rp.bh of
    1:secondary:='Monochrome';
    2:secondary:='CGA';
      end;
      findbios;
      if (getbios($31,9)='') and (getbios($40,2)='22') then
      begin
    video:='EGA';       {@#%@  lying ATI EGA Wonder !}
    cv.name:='ATI EGA Wonder';
    addvideo;
      end else
      if (rp.bl<10) or (rp.bl>12) then
      begin
        _MediaVis;
    chp:=0;vid1:=vids;
    while (vids=vid1) and (chp<chps) do
    begin
      inc(chp);

      video:='VGA';
      cv.chip:=__vga;
      cv.mm:=256;
      cv.features:=0;
      cv.dactype:=_dac0;
      cv.version:=0;
      cv.subvers:=0;
          cv.clktype:=clk_ext2;
          cv.flags:=FLG_StdVGA;
      if debug then
      begin
        writeln('Testing: '+header[chptype[chp]]);
        if readkey='' then;
      end;
      if dotest[chptype[chp]] then
            case chptype[chp] of
                __Acer:_Acer;
               __Ahead:_Ahead;
                 __ALG:_ALG;
                __Alli:_Alliance;
                 __ARK:_ARK;
                 __ati:_Ati;
               __chips:_chipstech;
               __Cir54:_Cirrus54;
               __Cir64:_Cirrus64;
              __Cirrus:_Cirrus;
              __Compaq:_Compaq;
              __Everex:_Everex;
               __Genoa:_Genoa;
                 __HMC:_HMC;
                __MXIC:_MXIC;
                 __NCR:_NCR;
                 __Oak:_Oak;
               __P2000:_P2000;
                  __WD:_paradise;
             __Realtek:_Realtek;
                  __S3:_S3;
                  __SC:_Sierra;
                 __SiS:_SiS;
                __Trid:_Trident;
               __Tseng:_Tseng;
                 __UMC:_UMC;
              __Video7:_Video7;
              __Weitek:_weitek;
              __Yamaha:_Yamaha;
              __Matrox:_matrox;
            end;
    end;
    if vids=vid1 then
        begin
          if force_chip<>__none then cv.chip:=force_chip;
          addvideo;
        end;
      end;
    end;
  end;
end;

begin
end.